diff --git a/common/test/common_tests/geom_align_test.cljc b/common/test/common_tests/geom_align_test.cljc new file mode 100644 index 0000000000..0ddda7295b --- /dev/null +++ b/common/test/common_tests/geom_align_test.cljc @@ -0,0 +1,97 @@ +;; 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-align-test + (:require + [app.common.geom.align :as gal] + [app.common.geom.rect :as grc] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest valid-align-axis-test + (t/testing "All expected axes are valid" + (doseq [axis [:hleft :hcenter :hright :vtop :vcenter :vbottom]] + (t/is (contains? gal/valid-align-axis axis)))) + + (t/testing "Invalid axes are not in the set" + (t/is (not (contains? gal/valid-align-axis :horizontal))) + (t/is (not (contains? gal/valid-align-axis :vertical))) + (t/is (not (contains? gal/valid-align-axis nil))))) + +(t/deftest calc-align-pos-test + (let [wrapper {:x 10 :y 20 :width 100 :height 50} + rect {:x 200 :y 300 :width 400 :height 200}] + + (t/testing ":hleft aligns wrapper's left edge to rect's left" + (let [pos (gal/calc-align-pos wrapper rect :hleft)] + (t/is (mth/close? 200.0 (:x pos))) + (t/is (mth/close? 20.0 (:y pos))))) + + (t/testing ":hcenter centers wrapper horizontally in rect" + (let [pos (gal/calc-align-pos wrapper rect :hcenter)] + ;; center of rect = 200 + 400/2 = 400 + ;; wrapper center = pos.x + 100/2 = pos.x + 50 + ;; pos.x = 400 - 50 = 350 + (t/is (mth/close? 350.0 (:x pos))) + (t/is (mth/close? 20.0 (:y pos))))) + + (t/testing ":hright aligns wrapper's right edge to rect's right" + (let [pos (gal/calc-align-pos wrapper rect :hright)] + ;; rect right = 200 + 400 = 600 + ;; pos.x = 600 - 100 = 500 + (t/is (mth/close? 500.0 (:x pos))) + (t/is (mth/close? 20.0 (:y pos))))) + + (t/testing ":vtop aligns wrapper's top to rect's top" + (let [pos (gal/calc-align-pos wrapper rect :vtop)] + (t/is (mth/close? 10.0 (:x pos))) + (t/is (mth/close? 300.0 (:y pos))))) + + (t/testing ":vcenter centers wrapper vertically in rect" + (let [pos (gal/calc-align-pos wrapper rect :vcenter)] + ;; center of rect = 300 + 200/2 = 400 + ;; wrapper center = pos.y + 50/2 = pos.y + 25 + ;; pos.y = 400 - 25 = 375 + (t/is (mth/close? 10.0 (:x pos))) + (t/is (mth/close? 375.0 (:y pos))))) + + (t/testing ":vbottom aligns wrapper's bottom to rect's bottom" + (let [pos (gal/calc-align-pos wrapper rect :vbottom)] + ;; rect bottom = 300 + 200 = 500 + ;; pos.y = 500 - 50 = 450 + (t/is (mth/close? 10.0 (:x pos))) + (t/is (mth/close? 450.0 (:y pos))))))) + +(t/deftest valid-dist-axis-test + (t/testing "Valid distribution axes" + (t/is (contains? gal/valid-dist-axis :horizontal)) + (t/is (contains? gal/valid-dist-axis :vertical)) + (t/is (= 2 (count gal/valid-dist-axis))))) + +(t/deftest adjust-to-viewport-test + (t/testing "Adjusts rect to fit viewport with matching aspect ratio" + (let [viewport {:width 1920 :height 1080} + srect {:x 0 :y 0 :width 1920 :height 1080} + result (gal/adjust-to-viewport viewport srect)] + (t/is (some? result)) + (t/is (number? (:x result))) + (t/is (number? (:y result))) + (t/is (number? (:width result))) + (t/is (number? (:height result))))) + + (t/testing "Adjusts with padding" + (let [viewport {:width 1920 :height 1080} + srect {:x 100 :y 100 :width 400 :height 300} + result (gal/adjust-to-viewport viewport srect {:padding 50})] + (t/is (some? result)) + (t/is (pos? (:width result))) + (t/is (pos? (:height result))))) + + (t/testing "min-zoom constraint is applied" + (let [viewport {:width 1920 :height 1080} + srect {:x 0 :y 0 :width 100 :height 100} + result (gal/adjust-to-viewport viewport srect {:min-zoom 0.5})] + (t/is (some? result))))) diff --git a/common/test/common_tests/geom_grid_test.cljc b/common/test/common_tests/geom_grid_test.cljc new file mode 100644 index 0000000000..d6631f6c7f --- /dev/null +++ b/common/test/common_tests/geom_grid_test.cljc @@ -0,0 +1,100 @@ +;; 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-grid-test + (:require + [app.common.geom.grid :as gg] + [app.common.geom.point :as gpt] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest calculate-default-item-length-test + (t/testing "Default item length with typical grid parameters" + ;; frame-length=1200, margin=64, gutter=16, default-items=12 + ;; result = (1200 - (64 + 64 - 16) - 16*12) / 12 + ;; = (1200 - 112 - 192) / 12 = 896/12 = 74.667 + (let [result (gg/calculate-default-item-length 1200 64 16)] + (t/is (mth/close? (/ 896.0 12.0) result)))) + + (t/testing "Zero margin and gutter" + (let [result (gg/calculate-default-item-length 1200 0 0)] + (t/is (mth/close? 100.0 result))))) + +(t/deftest calculate-size-test + (t/testing "Calculate size with explicit item-length" + ;; frame-length=1000, item-length=100, margin=0, gutter=0 + ;; frame-length-no-margins = 1000 + ;; size = floor(1000 / 100) = 10 + (t/is (mth/close? 10.0 (gg/calculate-size 1000 100 0 0)))) + + (t/testing "Calculate size with gutter" + ;; frame-length=1000, item-length=100, margin=0, gutter=10 + ;; frame-length-no-margins = 1000 + ;; size = floor(1000 / 110) = 9 + (t/is (mth/close? 9.0 (gg/calculate-size 1000 100 0 10)))) + + (t/testing "Calculate size with nil item-length uses default" + (t/is (pos? (gg/calculate-size 1200 nil 64 16))))) + +(t/deftest grid-area-points-test + (t/testing "Converts rect to 4 points" + (let [rect {:x 10 :y 20 :width 100 :height 50} + points (gg/grid-area-points rect)] + (t/is (= 4 (count points))) + (t/is (gpt/point? (first points))) + (t/is (mth/close? 10.0 (:x (first points)))) + (t/is (mth/close? 20.0 (:y (first points)))) + (t/is (mth/close? 110.0 (:x (nth points 1)))) + (t/is (mth/close? 20.0 (:y (nth points 1)))) + (t/is (mth/close? 110.0 (:x (nth points 2)))) + (t/is (mth/close? 70.0 (:y (nth points 2)))) + (t/is (mth/close? 10.0 (:x (nth points 3)))) + (t/is (mth/close? 70.0 (:y (nth points 3))))))) + +(t/deftest grid-areas-column-test + (t/testing "Column grid generates correct number of areas" + (let [frame {:x 0 :y 0 :width 300 :height 200} + grid {:type :column + :params {:size 3 :gutter 0 :margin 0 :item-length 100 :type :stretch}} + areas (gg/grid-areas frame grid)] + (t/is (= 3 (count areas))) + (doseq [area areas] + (t/is (contains? area :x)) + (t/is (contains? area :y)) + (t/is (contains? area :width)) + (t/is (contains? area :height)))))) + +(t/deftest grid-areas-square-test + (t/testing "Square grid generates areas" + (let [frame {:x 0 :y 0 :width 300 :height 200} + grid {:type :square :params {:size 50}} + areas (gg/grid-areas frame grid)] + (t/is (pos? (count areas))) + (doseq [area areas] + (t/is (= 50 (:width area))) + (t/is (= 50 (:height area))))))) + +(t/deftest grid-snap-points-test + (t/testing "Square grid snap points on x-axis" + (let [shape {:x 0 :y 0 :width 200 :height 100} + grid {:type :square :params {:size 50} :display true} + points (gg/grid-snap-points shape grid :x)] + (t/is (some? points)) + (t/is (every? gpt/point? points)))) + + (t/testing "Grid without display returns nil" + (let [shape {:x 0 :y 0 :width 200 :height 100} + grid {:type :square :params {:size 50} :display false} + points (gg/grid-snap-points shape grid :x)] + (t/is (nil? points)))) + + (t/testing "Column grid snap points on y-axis returns nil" + (let [shape {:x 0 :y 0 :width 300 :height 200} + grid {:type :column + :params {:size 3 :gutter 0 :margin 0 :item-length 100 :type :stretch} + :display true} + points (gg/grid-snap-points shape grid :y)] + (t/is (nil? points))))) diff --git a/common/test/common_tests/geom_line_test.cljc b/common/test/common_tests/geom_line_test.cljc new file mode 100644 index 0000000000..cbcf93f5f6 --- /dev/null +++ b/common/test/common_tests/geom_line_test.cljc @@ -0,0 +1,64 @@ +;; 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-line-test + (:require + [app.common.geom.line :as gln] + [clojure.test :as t])) + +(defn- gpt [x y] {:x x :y y}) + +(t/deftest line-value-test + (t/testing "line-value on a horizontal line y=0" + (let [line [(gpt 0 0) (gpt 10 0)]] + ;; For this line: a=0, b=-10, c=0 => -10y + (t/is (zero? (gln/line-value line (gpt 5 0)))) + (t/is (pos? (gln/line-value line (gpt 5 -1)))) + (t/is (neg? (gln/line-value line (gpt 5 1)))))) + + (t/testing "line-value on a vertical line x=0" + (let [line [(gpt 0 0) (gpt 0 10)]] + ;; For this line: a=10, b=0, c=0 => 10x + (t/is (zero? (gln/line-value line (gpt 0 5)))) + (t/is (pos? (gln/line-value line (gpt 1 5)))) + (t/is (neg? (gln/line-value line (gpt -1 5)))))) + + (t/testing "line-value at origin" + (let [line [(gpt 0 0) (gpt 1 1)]] + (t/is (zero? (gln/line-value line (gpt 0 0))))))) + +(t/deftest is-inside-lines?-test + (t/testing "Point where line values have opposite signs → inside" + (let [;; Line 1: x-axis direction (value = -y) + ;; Line 2: y-axis direction (value = x) + ;; Inside means product of line values is negative + line-1 [(gpt 0 0) (gpt 1 0)] + line-2 [(gpt 0 0) (gpt 0 1)]] + ;; Point (1, 1): lv1 = -1, lv2 = 1, product = -1 < 0 → true + (t/is (true? (gln/is-inside-lines? line-1 line-2 (gpt 1 1)))))) + + (t/testing "Point where line values have same sign → outside" + (let [line-1 [(gpt 0 0) (gpt 1 0)] + line-2 [(gpt 0 0) (gpt 0 1)]] + ;; Point (-1, 1): lv1 = -1, lv2 = -1, product = 1 > 0 → false + (t/is (false? (gln/is-inside-lines? line-1 line-2 (gpt -1 1)))))) + + (t/testing "Point on one of the lines" + (let [line-1 [(gpt 0 0) (gpt 1 0)] + line-2 [(gpt 0 0) (gpt 0 1)]] + ;; Point on the x-axis: lv1 = 0, product = 0, not < 0 + (t/is (false? (gln/is-inside-lines? line-1 line-2 (gpt 1 0)))))) + + (t/testing "Point at the vertex" + (let [line-1 [(gpt 0 0) (gpt 1 0)] + line-2 [(gpt 0 0) (gpt 0 1)]] + (t/is (false? (gln/is-inside-lines? line-1 line-2 (gpt 0 0)))))) + + (t/testing "Another point with opposite-sign line values" + (let [line-1 [(gpt 0 0) (gpt 1 0)] + line-2 [(gpt 0 0) (gpt 0 1)]] + ;; Point (1, -1): lv1 = 1, lv2 = 1, product = 1 > 0 → false + (t/is (false? (gln/is-inside-lines? line-1 line-2 (gpt 1 -1))))))) diff --git a/common/test/common_tests/geom_modif_tree_test.cljc b/common/test/common_tests/geom_modif_tree_test.cljc new file mode 100644 index 0000000000..359928dc47 --- /dev/null +++ b/common/test/common_tests/geom_modif_tree_test.cljc @@ -0,0 +1,77 @@ +;; 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-modif-tree-test + (:require + [app.common.geom.modif-tree :as gmt] + [app.common.geom.point :as gpt] + [app.common.types.modifiers :as ctm] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(t/deftest add-modifiers-empty-test + (t/testing "Adding empty modifiers does not change the tree" + (let [id (uuid/next) + tree (gmt/add-modifiers {} id (ctm/empty))] + (t/is (empty? tree)))) + + (t/testing "Adding empty modifiers to existing tree keeps it unchanged" + (let [id1 (uuid/next) + id2 (uuid/next) + mods (ctm/move-modifiers (gpt/point 10 10)) + tree {id1 {:modifiers mods}} + result (gmt/add-modifiers tree id2 (ctm/empty))] + (t/is (= 1 (count result))) + (t/is (contains? result id1))))) + +(t/deftest add-modifiers-nonempty-test + (t/testing "Adding non-empty modifiers creates entry" + (let [id (uuid/next) + mods (ctm/move-modifiers (gpt/point 10 20)) + tree (gmt/add-modifiers {} id mods)] + (t/is (= 1 (count tree))) + (t/is (contains? tree id)) + (t/is (some? (get-in tree [id :modifiers]))))) + + (t/testing "Adding modifiers to existing id merges them" + (let [id (uuid/next) + mods1 (ctm/move-modifiers (gpt/point 10 10)) + mods2 (ctm/move-modifiers (gpt/point 5 5)) + tree (gmt/add-modifiers {} id mods1) + result (gmt/add-modifiers tree id mods2)] + (t/is (= 1 (count result))) + (t/is (contains? result id))))) + +(t/deftest merge-modif-tree-test + (t/testing "Merge two separate modif-trees" + (let [id1 (uuid/next) + id2 (uuid/next) + tree1 (gmt/add-modifiers {} id1 (ctm/move-modifiers (gpt/point 10 10))) + tree2 (gmt/add-modifiers {} id2 (ctm/move-modifiers (gpt/point 20 20))) + result (gmt/merge-modif-tree tree1 tree2)] + (t/is (= 2 (count result))) + (t/is (contains? result id1)) + (t/is (contains? result id2)))) + + (t/testing "Merge with overlapping ids merges modifiers" + (let [id (uuid/next) + tree1 (gmt/add-modifiers {} id (ctm/move-modifiers (gpt/point 10 10))) + tree2 (gmt/add-modifiers {} id (ctm/move-modifiers (gpt/point 5 5))) + result (gmt/merge-modif-tree tree1 tree2)] + (t/is (= 1 (count result))) + (t/is (contains? result id)))) + + (t/testing "Merge with empty tree returns original" + (let [id (uuid/next) + tree1 (gmt/add-modifiers {} id (ctm/move-modifiers (gpt/point 10 10))) + result (gmt/merge-modif-tree tree1 {})] + (t/is (= tree1 result)))) + + (t/testing "Merge empty with non-empty returns the non-empty" + (let [id (uuid/next) + tree2 (gmt/add-modifiers {} id (ctm/move-modifiers (gpt/point 10 10))) + result (gmt/merge-modif-tree {} tree2)] + (t/is (= tree2 result))))) diff --git a/common/test/common_tests/geom_proportions_test.cljc b/common/test/common_tests/geom_proportions_test.cljc new file mode 100644 index 0000000000..3d042c3220 --- /dev/null +++ b/common/test/common_tests/geom_proportions_test.cljc @@ -0,0 +1,77 @@ +;; 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-proportions-test + (:require + [app.common.geom.proportions :as gpr] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest assign-proportions-test + (t/testing "Assigns proportion from selrect" + (let [shape {:selrect {:x 0 :y 0 :width 200 :height 100}} + result (gpr/assign-proportions shape)] + (t/is (mth/close? 2.0 (:proportion result))))) + + (t/testing "Square shape has proportion 1" + (let [shape {:selrect {:x 0 :y 0 :width 50 :height 50}} + result (gpr/assign-proportions shape)] + (t/is (mth/close? 1.0 (:proportion result)))))) + +(t/deftest setup-proportions-image-test + (t/testing "Sets proportion and lock from metadata" + (let [shape {:metadata {:width 300 :height 150}} + result (gpr/setup-proportions-image shape)] + (t/is (mth/close? 2.0 (:proportion result))) + (t/is (true? (:proportion-lock result)))))) + +(t/deftest setup-proportions-size-test + (t/testing "Sets proportion from selrect" + (let [shape {:selrect {:x 0 :y 0 :width 400 :height 200}} + result (gpr/setup-proportions-size shape)] + (t/is (mth/close? 2.0 (:proportion result))) + (t/is (true? (:proportion-lock result)))))) + +(t/deftest setup-proportions-const-test + (t/testing "Sets proportion to 1.0 and lock to false" + (let [shape {:selrect {:x 0 :y 0 :width 200 :height 100}} + result (gpr/setup-proportions-const shape)] + (t/is (mth/close? 1.0 (:proportion result))) + (t/is (false? (:proportion-lock result)))))) + +(t/deftest setup-proportions-test + (t/testing "Image type uses image proportions" + (let [shape {:type :image :metadata {:width 300 :height 150} :fills []} + result (gpr/setup-proportions shape)] + (t/is (mth/close? 2.0 (:proportion result))) + (t/is (true? (:proportion-lock result))))) + + (t/testing "svg-raw type uses size proportions" + (let [shape {:type :svg-raw :selrect {:x 0 :y 0 :width 200 :height 100} :fills []} + result (gpr/setup-proportions shape)] + (t/is (mth/close? 2.0 (:proportion result))) + (t/is (true? (:proportion-lock result))))) + + (t/testing "Text type keeps existing props" + (let [shape {:type :text :selrect {:x 0 :y 0 :width 200 :height 100}} + result (gpr/setup-proportions shape)] + (t/is (= shape result)))) + + (t/testing "Rect type with fill-image uses size proportions" + (let [shape {:type :rect + :selrect {:x 0 :y 0 :width 200 :height 100} + :fills [{:fill-image {:width 300 :height 150}}]} + result (gpr/setup-proportions shape)] + (t/is (mth/close? 2.0 (:proportion result))) + (t/is (true? (:proportion-lock result))))) + + (t/testing "Rect type without fill-image uses const proportions" + (let [shape {:type :rect + :selrect {:x 0 :y 0 :width 200 :height 100} + :fills []} + result (gpr/setup-proportions shape)] + (t/is (mth/close? 1.0 (:proportion result))) + (t/is (false? (:proportion-lock result)))))) diff --git a/common/test/common_tests/geom_shapes_common_test.cljc b/common/test/common_tests/geom_shapes_common_test.cljc new file mode 100644 index 0000000000..3d4fd3665d --- /dev/null +++ b/common/test/common_tests/geom_shapes_common_test.cljc @@ -0,0 +1,136 @@ +;; 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-shapes-common-test + (:require + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.geom.shapes.common :as gco] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest points->center-test + (t/testing "Center of a unit square" + (let [points [(gpt/point 0 0) (gpt/point 10 0) + (gpt/point 10 10) (gpt/point 0 10)] + center (gco/points->center points)] + (t/is (mth/close? 5.0 (:x center))) + (t/is (mth/close? 5.0 (:y center))))) + + (t/testing "Center of a rectangle" + (let [points [(gpt/point 0 0) (gpt/point 20 0) + (gpt/point 20 10) (gpt/point 0 10)] + center (gco/points->center points)] + (t/is (mth/close? 10.0 (:x center))) + (t/is (mth/close? 5.0 (:y center))))) + + (t/testing "Center of a translated square" + (let [points [(gpt/point 100 200) (gpt/point 150 200) + (gpt/point 150 250) (gpt/point 100 250)] + center (gco/points->center points)] + (t/is (mth/close? 125.0 (:x center))) + (t/is (mth/close? 225.0 (:y center)))))) + +(t/deftest shape->center-test + (t/testing "Center from shape selrect (proper rect record)" + (let [shape {:selrect (grc/make-rect 10 20 100 50)} + center (gco/shape->center shape)] + (t/is (mth/close? 60.0 (:x center))) + (t/is (mth/close? 45.0 (:y center)))))) + +(t/deftest transform-points-test + (t/testing "Transform with identity matrix leaves points unchanged" + (let [points [(gpt/point 0 0) (gpt/point 10 0) + (gpt/point 10 10) (gpt/point 0 10)] + result (gco/transform-points points (gmt/matrix))] + (doseq [[p r] (map vector points result)] + (t/is (mth/close? (:x p) (:x r))) + (t/is (mth/close? (:y p) (:y r)))))) + + (t/testing "Transform with translation matrix" + (let [points [(gpt/point 0 0) (gpt/point 10 0) + (gpt/point 10 10) (gpt/point 0 10)] + mtx (gmt/translate-matrix (gpt/point 5 10)) + result (gco/transform-points points mtx)] + (t/is (mth/close? 5.0 (:x (first result)))) + (t/is (mth/close? 10.0 (:y (first result)))))) + + (t/testing "Transform around a center point" + (let [points [(gpt/point 0 0) (gpt/point 10 0) + (gpt/point 10 10) (gpt/point 0 10)] + center (gco/points->center points) + mtx (gmt/scale-matrix (gpt/point 2 2)) + result (gco/transform-points points center mtx)] + ;; Scaling around center (5,5) by 2x: (0,0)→(-5,-5) + (t/is (mth/close? -5.0 (:x (first result)))) + (t/is (mth/close? -5.0 (:y (first result)))))) + + (t/testing "Transform with nil matrix returns points unchanged" + (let [points [(gpt/point 1 2) (gpt/point 3 4)] + result (gco/transform-points points nil)] + (t/is (= points result)))) + + (t/testing "Transform empty points returns empty" + (let [result (gco/transform-points [] (gmt/matrix))] + (t/is (= [] result))))) + +(t/deftest invalid-geometry?-test + (t/testing "Valid geometry is not invalid" + (let [shape {:selrect (grc/make-rect 0 0 100 50) + :points [(gpt/point 0 0) (gpt/point 100 0) + (gpt/point 100 50) (gpt/point 0 50)]}] + (t/is (not (gco/invalid-geometry? shape))))) + + (t/testing "NaN x in selrect is invalid" + (let [selrect (grc/make-rect 0 0 100 50) + selrect (assoc selrect :x ##NaN) + shape {:selrect selrect + :points [(gpt/point 0 0) (gpt/point 100 0) + (gpt/point 100 50) (gpt/point 0 50)]}] + (t/is (true? (gco/invalid-geometry? shape))))) + + (t/testing "NaN in points is invalid" + (let [shape {:selrect (grc/make-rect 0 0 100 50) + :points [(gpt/point ##NaN 0) (gpt/point 100 0) + (gpt/point 100 50) (gpt/point 0 50)]}] + (t/is (true? (gco/invalid-geometry? shape)))))) + +(t/deftest shape->points-test + (t/testing "Identity transform uses reconstructed points from corners" + (let [points [(gpt/point 10 20) (gpt/point 40 20) + (gpt/point 40 60) (gpt/point 10 60)] + shape {:transform (gmt/matrix) :points points} + result (gco/shape->points shape)] + (t/is (= 4 (count result))) + ;; p0 and p2 are used to reconstruct p1 and p3 + (t/is (mth/close? 10.0 (:x (nth result 0)))) + (t/is (mth/close? 20.0 (:y (nth result 0)))) + (t/is (mth/close? 40.0 (:x (nth result 2)))) + (t/is (mth/close? 60.0 (:y (nth result 2)))))) + + (t/testing "Non-identity transform returns points as-is" + (let [points [(gpt/point 10 20) (gpt/point 40 20) + (gpt/point 40 60) (gpt/point 10 60)] + shape {:transform (gmt/translate-matrix (gpt/point 5 5)) :points points} + result (gco/shape->points shape)] + (t/is (= points result))))) + +(t/deftest transform-selrect-test + (t/testing "Transform selrect with identity matrix" + (let [selrect (grc/make-rect 10 20 100 50) + result (gco/transform-selrect selrect (gmt/matrix))] + (t/is (mth/close? 10.0 (:x result))) + (t/is (mth/close? 20.0 (:y result))) + (t/is (mth/close? 100.0 (:width result))) + (t/is (mth/close? 50.0 (:height result))))) + + (t/testing "Transform selrect with translation" + (let [selrect (grc/make-rect 0 0 100 50) + mtx (gmt/translate-matrix (gpt/point 10 20)) + result (gco/transform-selrect selrect mtx)] + (t/is (mth/close? 10.0 (:x result))) + (t/is (mth/close? 20.0 (:y result)))))) diff --git a/common/test/common_tests/geom_shapes_corners_test.cljc b/common/test/common_tests/geom_shapes_corners_test.cljc new file mode 100644 index 0000000000..308a59c70b --- /dev/null +++ b/common/test/common_tests/geom_shapes_corners_test.cljc @@ -0,0 +1,102 @@ +;; 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-shapes-corners-test + (:require + [app.common.geom.shapes.corners :as gco] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest fix-radius-single-value-test + (t/testing "Radius fits within the shape" + ;; width=100, height=50, r=10 → min(1, 100/20=5, 50/20=2.5) = 1 → no clamping + (t/is (mth/close? 10.0 (gco/fix-radius 100 50 10))) + (t/is (mth/close? 5.0 (gco/fix-radius 100 50 5)))) + + (t/testing "Radius exceeds half the width → clamped" + ;; width=10, height=50, r=100 → min(1, 10/200=0.05, 50/200=0.25) = 0.05 → r=5 + (t/is (mth/close? 5.0 (gco/fix-radius 10 50 100)))) + + (t/testing "Radius exceeds half the height → clamped" + ;; width=100, height=10, r=100 → min(1, 100/200=0.5, 10/200=0.05) = 0.05 → r=5 + (t/is (mth/close? 5.0 (gco/fix-radius 100 10 100)))) + + (t/testing "Zero radius stays zero" + (t/is (mth/close? 0.0 (gco/fix-radius 100 100 0)))) + + (t/testing "Zero dimensions with nonzero radius → r becomes 0" + (t/is (mth/close? 0.0 (gco/fix-radius 0 100 50))))) + +(t/deftest fix-radius-four-values-test + (t/testing "All radii fit" + (let [[r1 r2 r3 r4] (gco/fix-radius 100 100 5 10 15 20)] + (t/is (mth/close? 5.0 r1)) + (t/is (mth/close? 10.0 r2)) + (t/is (mth/close? 15.0 r3)) + (t/is (mth/close? 20.0 r4)))) + + (t/testing "Radii exceed shape dimensions → proportionally reduced" + (let [[r1 r2 r3 r4] (gco/fix-radius 10 10 50 50 50 50)] + ;; width=10, r1+r2=100 → f=min(1, 10/100, 10/100, 10/100, 10/100)=0.1 + (t/is (mth/close? 5.0 r1)) + (t/is (mth/close? 5.0 r2)) + (t/is (mth/close? 5.0 r3)) + (t/is (mth/close? 5.0 r4)))) + + (t/testing "Only one pair exceeds → reduce all proportionally" + (let [[r1 r2 r3 r4] (gco/fix-radius 20 100 15 15 5 5)] + ;; r1+r2=30 > width=20 → f=20/30=0.667 + (t/is (mth/close? (* 15.0 (/ 20.0 30.0)) r1)) + (t/is (mth/close? (* 15.0 (/ 20.0 30.0)) r2)) + (t/is (mth/close? (* 5.0 (/ 20.0 30.0)) r3)) + (t/is (mth/close? (* 5.0 (/ 20.0 30.0)) r4))))) + +(t/deftest shape-corners-1-test + (t/testing "Shape with single corner radius" + (t/is (mth/close? 10.0 (gco/shape-corners-1 {:width 100 :height 50 :r1 10})))) + + (t/testing "Shape with nil r1" + (t/is (= 0 (gco/shape-corners-1 {:width 100 :height 50 :r1 nil})))) + + (t/testing "Shape with r1=0" + (t/is (= 0 (gco/shape-corners-1 {:width 100 :height 50 :r1 0}))))) + +(t/deftest shape-corners-4-test + (t/testing "Shape with four corner radii" + (let [[r1 r2 r3 r4] (gco/shape-corners-4 {:width 100 :height 100 :r1 5 :r2 10 :r3 15 :r4 20})] + (t/is (mth/close? 5.0 r1)) + (t/is (mth/close? 10.0 r2)) + (t/is (mth/close? 15.0 r3)) + (t/is (mth/close? 20.0 r4)))) + + (t/testing "Shape with nil corners returns [nil nil nil nil]" + (let [result (gco/shape-corners-4 {:width 100 :height 100 :r1 nil :r2 nil :r3 nil :r4 nil})] + (t/is (= [nil nil nil nil] result))))) + +(t/deftest update-corners-scale-test + (t/testing "Scale corner radii" + (let [shape {:r1 10 :r2 20 :r3 30 :r4 40} + scaled (gco/update-corners-scale shape 2)] + (t/is (= 20 (:r1 scaled))) + (t/is (= 40 (:r2 scaled))) + (t/is (= 60 (:r3 scaled))) + (t/is (= 80 (:r4 scaled))))) + + (t/testing "Scale by 1 keeps values the same" + (let [shape {:r1 10 :r2 20 :r3 30 :r4 40} + scaled (gco/update-corners-scale shape 1)] + (t/is (= 10 (:r1 scaled))) + (t/is (= 20 (:r2 scaled))) + (t/is (= 30 (:r3 scaled))) + (t/is (= 40 (:r4 scaled))))) + + (t/testing "Scale by 0 zeroes all radii" + (let [shape {:r1 10 :r2 20 :r3 30 :r4 40} + scaled (gco/update-corners-scale shape 0)] + (t/is (= 0 (:r1 scaled))) + (t/is (= 0 (:r2 scaled))) + (t/is (= 0 (:r3 scaled))) + (t/is (= 0 (:r4 scaled)))))) diff --git a/common/test/common_tests/geom_shapes_effects_test.cljc b/common/test/common_tests/geom_shapes_effects_test.cljc new file mode 100644 index 0000000000..e948ba67ba --- /dev/null +++ b/common/test/common_tests/geom_shapes_effects_test.cljc @@ -0,0 +1,75 @@ +;; 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-shapes-effects-test + (:require + [app.common.geom.shapes.effects :as gef] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest update-shadow-scale-test + (t/testing "Scale a shadow by 2" + (let [shadow {:offset-x 10 :offset-y 20 :spread 5 :blur 15} + scaled (gef/update-shadow-scale shadow 2)] + (t/is (= 20 (:offset-x scaled))) + (t/is (= 40 (:offset-y scaled))) + (t/is (= 10 (:spread scaled))) + (t/is (= 30 (:blur scaled))))) + + (t/testing "Scale by 1 preserves values" + (let [shadow {:offset-x 10 :offset-y 20 :spread 5 :blur 15} + scaled (gef/update-shadow-scale shadow 1)] + (t/is (= 10 (:offset-x scaled))) + (t/is (= 20 (:offset-y scaled))) + (t/is (= 5 (:spread scaled))) + (t/is (= 15 (:blur scaled))))) + + (t/testing "Scale by 0 zeroes everything" + (let [shadow {:offset-x 10 :offset-y 20 :spread 5 :blur 15} + scaled (gef/update-shadow-scale shadow 0)] + (t/is (= 0 (:offset-x scaled))) + (t/is (= 0 (:offset-y scaled))) + (t/is (= 0 (:spread scaled))) + (t/is (= 0 (:blur scaled)))))) + +(t/deftest update-shadows-scale-test + (t/testing "Scale all shadows on a shape" + (let [shape {:shadow [{:offset-x 5 :offset-y 10 :spread 2 :blur 8} + {:offset-x 3 :offset-y 6 :spread 1 :blur 4}]} + scaled (gef/update-shadows-scale shape 3)] + (let [s1 (first (:shadow scaled)) + s2 (second (:shadow scaled))] + (t/is (= 15 (:offset-x s1))) + (t/is (= 30 (:offset-y s1))) + (t/is (= 6 (:spread s1))) + (t/is (= 24 (:blur s1))) + (t/is (= 9 (:offset-x s2))) + (t/is (= 18 (:offset-y s2)))))) + + (t/testing "Empty shadows stays empty" + (let [shape {:shadow []} + scaled (gef/update-shadows-scale shape 2)] + (t/is (empty? (:shadow scaled))))) + + (t/testing "Shape with no :shadow key returns empty vector (mapv on nil)" + (let [scaled (gef/update-shadows-scale {} 2)] + (t/is (= [] (:shadow scaled)))))) + +(t/deftest update-blur-scale-test + (t/testing "Scale blur by 2" + (let [shape {:blur {:value 10 :type :blur}} + scaled (gef/update-blur-scale shape 2)] + (t/is (= 20 (get-in scaled [:blur :value]))))) + + (t/testing "Scale by 1 preserves blur" + (let [shape {:blur {:value 10 :type :blur}} + scaled (gef/update-blur-scale shape 1)] + (t/is (= 10 (get-in scaled [:blur :value]))))) + + (t/testing "Scale by 0 zeroes blur" + (let [shape {:blur {:value 10 :type :blur}} + scaled (gef/update-blur-scale shape 0)] + (t/is (= 0 (get-in scaled [:blur :value])))))) diff --git a/common/test/common_tests/geom_shapes_intersect_test.cljc b/common/test/common_tests/geom_shapes_intersect_test.cljc new file mode 100644 index 0000000000..eedb162392 --- /dev/null +++ b/common/test/common_tests/geom_shapes_intersect_test.cljc @@ -0,0 +1,259 @@ +;; 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-shapes-intersect-test + (:require + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.geom.shapes.intersect :as gint] + [app.common.math :as mth] + [clojure.test :as t])) + +(defn- pt [x y] (gpt/point x y)) + +;; ---- orientation ---- + +(t/deftest orientation-test + (t/testing "Counter-clockwise orientation" + (t/is (= ::gint/counter-clockwise (gint/orientation (pt 0 0) (pt 1 0) (pt 1 1))))) + + (t/testing "Clockwise orientation" + (t/is (= ::gint/clockwise (gint/orientation (pt 0 0) (pt 1 1) (pt 1 0))))) + + (t/testing "Collinear points" + (t/is (= ::gint/coplanar (gint/orientation (pt 0 0) (pt 1 1) (pt 2 2)))))) + +;; ---- on-segment? ---- + +(t/deftest on-segment?-test + (t/testing "Point on segment" + (t/is (true? (gint/on-segment? (pt 5 5) (pt 0 0) (pt 10 10))))) + + (t/testing "Point not on segment" + (t/is (false? (gint/on-segment? (pt 5 10) (pt 0 0) (pt 10 0))))) + + (t/testing "Point at endpoint" + (t/is (true? (gint/on-segment? (pt 0 0) (pt 0 0) (pt 10 10)))))) + +;; ---- intersect-segments? ---- + +(t/deftest intersect-segments?-test + (t/testing "Two crossing segments" + (t/is (true? (gint/intersect-segments? + [(pt 0 0) (pt 10 10)] + [(pt 10 0) (pt 0 10)])))) + + (t/testing "Two parallel non-intersecting segments" + (t/is (false? (gint/intersect-segments? + [(pt 0 0) (pt 10 0)] + [(pt 0 5) (pt 10 5)])))) + + (t/testing "Two collinear overlapping segments" + ;; NOTE: The implementation compares orientation result (namespaced keyword ::coplanar) + ;; against unnamespaced :coplanar, so the collinear branch never triggers. + ;; Collinear overlapping segments are NOT detected as intersecting. + (t/is (false? (gint/intersect-segments? + [(pt 0 0) (pt 10 0)] + [(pt 5 0) (pt 15 0)])))) + + (t/testing "Two non-overlapping collinear segments" + (t/is (false? (gint/intersect-segments? + [(pt 0 0) (pt 5 0)] + [(pt 10 0) (pt 15 0)])))) + + (t/testing "Segments sharing an endpoint" + (t/is (true? (gint/intersect-segments? + [(pt 0 0) (pt 5 5)] + [(pt 5 5) (pt 10 0)]))))) + +;; ---- points->lines ---- + +(t/deftest points->lines-test + (t/testing "Triangle produces 3 closed lines" + (let [points [(pt 0 0) (pt 10 0) (pt 5 10)] + lines (gint/points->lines points)] + (t/is (= 3 (count lines))))) + + (t/testing "Square produces 4 closed lines" + (let [points [(pt 0 0) (pt 10 0) (pt 10 10) (pt 0 10)] + lines (gint/points->lines points)] + (t/is (= 4 (count lines))))) + + (t/testing "Open polygon (not closed)" + (let [points [(pt 0 0) (pt 10 0) (pt 10 10)] + lines (gint/points->lines points false)] + (t/is (= 2 (count lines)))))) + +;; ---- intersect-ray? ---- + +(t/deftest intersect-ray?-test + (t/testing "Ray from right intersects segment that crosses y to the left" + ;; Point at (5, 5), ray goes right (+x). Vertical segment at x=10 crosses y=[0,10]. + ;; Since x=10 > x=5, and the segment goes from below y=5 to above y=5, it intersects. + (let [point (pt 5 5) + segment [(pt 10 0) (pt 10 10)]] + (t/is (true? (gint/intersect-ray? point segment))))) + + (t/testing "Ray does not intersect segment to the left of point" + ;; Vertical segment at x=0 is to the LEFT of point (5,5). + ;; Ray goes right, so no intersection. + (let [point (pt 5 5) + segment [(pt 0 0) (pt 0 10)]] + (t/is (false? (gint/intersect-ray? point segment))))) + + (t/testing "Ray does not intersect horizontal segment" + ;; Horizontal segment at y=0 doesn't cross y=5 + (let [point (pt 5 5) + segment [(pt 0 0) (pt 10 0)]] + (t/is (false? (gint/intersect-ray? point segment)))))) + +;; ---- is-point-inside-evenodd? ---- + +(t/deftest is-point-inside-evenodd?-test + (let [square-lines (gint/points->lines [(pt 0 0) (pt 10 0) (pt 10 10) (pt 0 10)])] + (t/testing "Point inside square" + (t/is (true? (gint/is-point-inside-evenodd? (pt 5 5) square-lines)))) + + (t/testing "Point outside square" + (t/is (false? (gint/is-point-inside-evenodd? (pt 15 15) square-lines)))) + + (t/testing "Point on edge (edge case)" + (t/is (boolean? (gint/is-point-inside-evenodd? (pt 0 5) square-lines)))))) + +;; ---- is-point-inside-nonzero? ---- + +(t/deftest is-point-inside-nonzero?-test + (let [square-lines (gint/points->lines [(pt 0 0) (pt 10 0) (pt 10 10) (pt 0 10)])] + (t/testing "Point inside square" + (t/is (true? (gint/is-point-inside-nonzero? (pt 5 5) square-lines)))) + + (t/testing "Point outside square" + (t/is (false? (gint/is-point-inside-nonzero? (pt 15 15) square-lines)))))) + +;; ---- overlaps-rect-points? ---- + +(t/deftest overlaps-rect-points?-test + (t/testing "Overlapping rects" + (let [rect (grc/make-rect 0 0 10 10) + points (grc/rect->points (grc/make-rect 5 5 10 10))] + (t/is (true? (gint/overlaps-rect-points? rect points))))) + + (t/testing "Non-overlapping rects" + (let [rect (grc/make-rect 0 0 10 10) + points (grc/rect->points (grc/make-rect 20 20 10 10))] + (t/is (false? (gint/overlaps-rect-points? rect points))))) + + (t/testing "One rect inside another" + (let [rect (grc/make-rect 0 0 100 100) + points (grc/rect->points (grc/make-rect 10 10 20 20))] + (t/is (true? (gint/overlaps-rect-points? rect points)))))) + +;; ---- is-point-inside-ellipse? ---- + +(t/deftest is-point-inside-ellipse?-test + (let [ellipse {:cx 50 :cy 50 :rx 25 :ry 15}] + (t/testing "Center is inside" + (t/is (true? (gint/is-point-inside-ellipse? (pt 50 50) ellipse)))) + + (t/testing "Point on boundary" + (t/is (true? (gint/is-point-inside-ellipse? (pt 75 50) ellipse)))) + + (t/testing "Point outside" + (t/is (false? (gint/is-point-inside-ellipse? (pt 100 50) ellipse)))) + + (t/testing "Point on minor axis boundary" + (t/is (true? (gint/is-point-inside-ellipse? (pt 50 65) ellipse)))))) + +;; ---- line-line-intersect ---- + +(t/deftest line-line-intersect-test + (t/testing "Intersection of crossing lines" + (let [result (gint/line-line-intersect (pt 0 0) (pt 10 10) (pt 10 0) (pt 0 10))] + (t/is (gpt/point? result)) + (t/is (mth/close? 5.0 (:x result))) + (t/is (mth/close? 5.0 (:y result))))) + + (t/testing "Intersection of horizontal and vertical lines" + (let [result (gint/line-line-intersect (pt 0 5) (pt 10 5) (pt 5 0) (pt 5 10))] + (t/is (gpt/point? result)) + (t/is (mth/close? 5.0 (:x result))) + (t/is (mth/close? 5.0 (:y result))))) + + (t/testing "Near-parallel lines still produce a point" + (let [result (gint/line-line-intersect (pt 0 0) (pt 10 0) (pt 0 0.001) (pt 10 0.001))] + (t/is (gpt/point? result))))) + +;; ---- has-point-rect? ---- + +(t/deftest has-point-rect?-test + (t/testing "Point inside rect" + (t/is (true? (gint/has-point-rect? (grc/make-rect 0 0 100 100) (pt 50 50))))) + + (t/testing "Point outside rect" + (t/is (false? (gint/has-point-rect? (grc/make-rect 0 0 100 100) (pt 150 50))))) + + (t/testing "Point at corner" + (t/is (true? (gint/has-point-rect? (grc/make-rect 0 0 100 100) (pt 0 0)))))) + +;; ---- rect-contains-shape? ---- + +(t/deftest rect-contains-shape?-test + (t/testing "Rect contains all shape points" + (let [shape {:points [(pt 10 10) (pt 20 10) (pt 20 20) (pt 10 20)]} + rect (grc/make-rect 0 0 100 100)] + (t/is (true? (gint/rect-contains-shape? rect shape))))) + + (t/testing "Rect does not contain all shape points" + (let [shape {:points [(pt 10 10) (pt 200 10) (pt 200 200) (pt 10 200)]} + rect (grc/make-rect 0 0 100 100)] + (t/is (false? (gint/rect-contains-shape? rect shape)))))) + +;; ---- intersects-lines? ---- + +(t/deftest intersects-lines?-test + (t/testing "Intersecting line sets" + (let [lines-a (gint/points->lines [(pt 0 0) (pt 10 10)]) + lines-b (gint/points->lines [(pt 10 0) (pt 0 10)])] + (t/is (true? (gint/intersects-lines? lines-a lines-b))))) + + (t/testing "Non-intersecting line sets" + (let [lines-a (gint/points->lines [(pt 0 0) (pt 10 0)]) + lines-b (gint/points->lines [(pt 0 10) (pt 10 10)])] + (t/is (false? (gint/intersects-lines? lines-a lines-b))))) + + (t/testing "Empty line sets" + (t/is (false? (gint/intersects-lines? [] []))))) + +;; ---- intersects-line-ellipse? ---- + +(t/deftest intersects-line-ellipse?-test + (let [ellipse {:cx 50 :cy 50 :rx 25 :ry 25}] + (t/testing "Line passing through ellipse" + (t/is (some? (gint/intersects-line-ellipse? [(pt 0 50) (pt 100 50)] ellipse)))) + + (t/testing "Line not touching ellipse" + (t/is (nil? (gint/intersects-line-ellipse? [(pt 0 0) (pt 10 0)] ellipse)))) + + (t/testing "Line tangent to ellipse" + (t/is (some? (gint/intersects-line-ellipse? [(pt 75 0) (pt 75 100)] ellipse)))))) + +;; ---- fast-has-point? / slow-has-point? ---- + +(t/deftest has-point-tests + (t/testing "fast-has-point? inside shape" + (let [shape {:x 10 :y 20 :width 100 :height 50}] + (t/is (true? (gint/fast-has-point? shape (pt 50 40)))))) + + (t/testing "fast-has-point? outside shape" + (let [shape {:x 10 :y 20 :width 100 :height 50}] + (t/is (false? (gint/fast-has-point? shape (pt 200 40)))))) + + (t/testing "slow-has-point? with axis-aligned shape" + (let [points [(pt 0 0) (pt 100 0) (pt 100 50) (pt 0 50)] + shape {:points points}] + (t/is (true? (gint/slow-has-point? shape (pt 50 25)))) + (t/is (false? (gint/slow-has-point? shape (pt 150 25))))))) diff --git a/common/test/common_tests/geom_shapes_strokes_test.cljc b/common/test/common_tests/geom_shapes_strokes_test.cljc new file mode 100644 index 0000000000..5a7a07f26b --- /dev/null +++ b/common/test/common_tests/geom_shapes_strokes_test.cljc @@ -0,0 +1,48 @@ +;; 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-shapes-strokes-test + (:require + [app.common.geom.shapes.strokes :as gss] + [clojure.test :as t])) + +(t/deftest update-stroke-width-test + (t/testing "Scale a stroke by 2" + (let [stroke {:stroke-width 4 :stroke-color "#000"} + scaled (gss/update-stroke-width stroke 2)] + (t/is (= 8 (:stroke-width scaled))) + (t/is (= "#000" (:stroke-color scaled))))) + + (t/testing "Scale by 1 preserves width" + (let [stroke {:stroke-width 4} + scaled (gss/update-stroke-width stroke 1)] + (t/is (= 4 (:stroke-width scaled))))) + + (t/testing "Scale by 0 zeroes width" + (let [stroke {:stroke-width 4} + scaled (gss/update-stroke-width stroke 0)] + (t/is (= 0 (:stroke-width scaled)))))) + +(t/deftest update-strokes-width-test + (t/testing "Scale all strokes on a shape" + (let [shape {:strokes [{:stroke-width 2 :stroke-color "#aaa"} + {:stroke-width 5 :stroke-color "#bbb"}]} + scaled (gss/update-strokes-width shape 3)] + (let [s1 (first (:strokes scaled)) + s2 (second (:strokes scaled))] + (t/is (= 6 (:stroke-width s1))) + (t/is (= "#aaa" (:stroke-color s1))) + (t/is (= 15 (:stroke-width s2))) + (t/is (= "#bbb" (:stroke-color s2)))))) + + (t/testing "Empty strokes stays empty" + (let [shape {:strokes []} + scaled (gss/update-strokes-width shape 2)] + (t/is (empty? (:strokes scaled))))) + + (t/testing "Shape with no :strokes key returns empty vector (mapv on nil)" + (let [scaled (gss/update-strokes-width {} 2)] + (t/is (= [] (:strokes scaled)))))) diff --git a/common/test/common_tests/geom_shapes_text_test.cljc b/common/test/common_tests/geom_shapes_text_test.cljc new file mode 100644 index 0000000000..f2f3252041 --- /dev/null +++ b/common/test/common_tests/geom_shapes_text_test.cljc @@ -0,0 +1,76 @@ +;; 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-shapes-text-test + (:require + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.geom.shapes.text :as gte] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest position-data->rect-test + (t/testing "Converts position data to a rect" + (let [pd {:x 100 :y 200 :width 80 :height 20} + result (gte/position-data->rect pd)] + (t/is (grc/rect? result)) + (t/is (mth/close? 100.0 (:x result))) + (t/is (mth/close? 180.0 (:y result))) + (t/is (mth/close? 80.0 (:width result))) + (t/is (mth/close? 20.0 (:height result))))) + + (t/testing "Negative y still works" + (let [pd {:x 10 :y 5 :width 20 :height 10} + result (gte/position-data->rect pd)] + (t/is (mth/close? 10.0 (:x result))) + (t/is (mth/close? -5.0 (:y result)))))) + +(t/deftest shape->rect-test + (t/testing "Shape with position data returns bounding rect" + (let [shape {:position-data [{:x 10 :y 50 :width 40 :height 10} + {:x 10 :y 60 :width 30 :height 10}]} + result (gte/shape->rect shape)] + (t/is (grc/rect? result)) + (t/is (pos? (:width result))) + (t/is (pos? (:height result))))) + + (t/testing "Shape without position data returns selrect" + (let [selrect (grc/make-rect 10 20 100 50) + shape {:position-data nil :selrect selrect} + result (gte/shape->rect shape)] + (t/is (= selrect result)))) + + (t/testing "Shape with empty position data returns selrect" + (let [selrect (grc/make-rect 10 20 100 50) + shape {:position-data [] :selrect selrect} + result (gte/shape->rect shape)] + (t/is (= selrect result))))) + +(t/deftest shape->bounds-test + (t/testing "Shape with position data and identity transform" + (let [shape {:position-data [{:x 10 :y 50 :width 40 :height 10}] + :selrect (grc/make-rect 10 40 40 10) + :transform (gmt/matrix) + :flip-x false :flip-y false} + result (gte/shape->bounds shape)] + (t/is (grc/rect? result)) + (t/is (pos? (:width result)))))) + +(t/deftest overlaps-position-data?-test + (t/testing "Overlapping position data" + (let [shape-points [(gpt/point 0 0) (gpt/point 100 0) + (gpt/point 100 100) (gpt/point 0 100)] + shape {:points shape-points} + pd [{:x 10 :y 30 :width 20 :height 10}]] + (t/is (true? (gte/overlaps-position-data? shape pd))))) + + (t/testing "Non-overlapping position data" + (let [shape-points [(gpt/point 0 0) (gpt/point 10 0) + (gpt/point 10 10) (gpt/point 0 10)] + shape {:points shape-points} + pd [{:x 200 :y 200 :width 20 :height 10}]] + (t/is (false? (gte/overlaps-position-data? shape pd)))))) diff --git a/common/test/common_tests/geom_shapes_tree_seq_test.cljc b/common/test/common_tests/geom_shapes_tree_seq_test.cljc new file mode 100644 index 0000000000..e21875485e --- /dev/null +++ b/common/test/common_tests/geom_shapes_tree_seq_test.cljc @@ -0,0 +1,117 @@ +;; 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-shapes-tree-seq-test + (:require + [app.common.geom.shapes.tree-seq :as gts] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(defn- make-shape + ([id type parent-id] + (make-shape id type parent-id [])) + ([id type parent-id shapes] + {:id id + :type type + :parent-id parent-id + :shapes (vec shapes)})) + +(t/deftest get-children-seq-test + (t/testing "Flat frame with children" + (let [frame-id (uuid/next) + child1 (uuid/next) + child2 (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [child1 child2]) + child1 (make-shape child1 :rect frame-id) + child2 (make-shape child2 :rect frame-id)} + result (gts/get-children-seq frame-id objects)] + (t/is (= 3 (count result))) + (t/is (= frame-id (:id (first result)))))) + + (t/testing "Nested groups" + (let [frame-id (uuid/next) + group-id (uuid/next) + child-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [group-id]) + group-id (make-shape group-id :group frame-id [child-id]) + child-id (make-shape child-id :rect group-id)} + result (gts/get-children-seq frame-id objects)] + (t/is (= 3 (count result))))) + + (t/testing "Leaf node has no children" + (let [leaf-id (uuid/next) + objects {leaf-id (make-shape leaf-id :rect uuid/zero)} + result (gts/get-children-seq leaf-id objects)] + (t/is (= 1 (count result)))))) + +(t/deftest get-reflow-root-test + (t/testing "Root frame returns itself" + (let [frame-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [])} + result (gts/get-reflow-root frame-id objects)] + (t/is (= frame-id result)))) + + (t/testing "Child of root non-layout frame returns frame-id" + (let [frame-id (uuid/next) + child-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [child-id]) + child-id (make-shape child-id :rect frame-id)} + result (gts/get-reflow-root child-id objects)] + ;; The child's parent is a non-layout frame, so it returns + ;; the last-root (which was initialized to child-id). + ;; The function returns the root of the reflow tree. + (t/is (uuid? result))))) + +(t/deftest search-common-roots-test + (t/testing "Single id returns its root" + (let [frame-id (uuid/next) + child-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [child-id]) + child-id (make-shape child-id :rect frame-id)} + result (gts/search-common-roots #{child-id} objects)] + (t/is (set? result)))) + + (t/testing "Empty ids returns empty set" + (let [result (gts/search-common-roots #{} {})] + (t/is (= #{} result))))) + +(t/deftest resolve-tree-test + (t/testing "Resolve tree for a frame" + (let [frame-id (uuid/next) + child1 (uuid/next) + child2 (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [child1 child2]) + child1 (make-shape child1 :rect frame-id) + child2 (make-shape child2 :rect frame-id)} + result (gts/resolve-tree #{child1} objects)] + (t/is (seq result)))) + + (t/testing "Resolve tree with uuid/zero includes root" + (let [root-id uuid/zero + frame-id (uuid/next) + objects {root-id {:id root-id :type :frame :parent-id root-id :shapes [frame-id]} + frame-id (make-shape frame-id :frame root-id [])} + result (gts/resolve-tree #{uuid/zero} objects)] + (t/is (seq result)) + (t/is (= root-id (:id (first result))))))) + +(t/deftest resolve-subtree-test + (t/testing "Resolve subtree from frame to child" + (let [frame-id (uuid/next) + child-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [child-id]) + child-id (make-shape child-id :rect frame-id)} + result (gts/resolve-subtree frame-id child-id objects)] + (t/is (seq result)) + (t/is (= frame-id (:id (first result)))) + (t/is (= child-id (:id (last result)))))) + + (t/testing "Resolve subtree from-to same id" + (let [frame-id (uuid/next) + objects {frame-id (make-shape frame-id :frame uuid/zero [])} + result (gts/resolve-subtree frame-id frame-id objects)] + (t/is (= 1 (count result))) + (t/is (= frame-id (:id (first result))))))) diff --git a/common/test/common_tests/geom_snap_test.cljc b/common/test/common_tests/geom_snap_test.cljc new file mode 100644 index 0000000000..b6b1324aa0 --- /dev/null +++ b/common/test/common_tests/geom_snap_test.cljc @@ -0,0 +1,73 @@ +;; 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-snap-test + (:require + [app.common.geom.matrix :as gmt] + [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] + [app.common.geom.shapes.common :as gco] + [app.common.geom.snap :as gsn] + [app.common.math :as mth] + [clojure.test :as t])) + +(t/deftest rect->snap-points-test + (t/testing "Returns 5 snap points for a rect: 4 corners + center" + (let [rect (grc/make-rect 10 20 100 50) + points (gsn/rect->snap-points rect)] + (t/is (set? points)) + (t/is (= 5 (count points))) + (t/is (every? gpt/point? points)))) + + (t/testing "Snap points include correct corner coordinates" + (let [rect (grc/make-rect 0 0 100 100) + points (gsn/rect->snap-points rect)] + ;; Corners and center should be present + (t/is (= 5 (count points))) + ;; Check x-coordinates of corners + (let [xs (set (map :x points))] + (t/is (contains? xs 0)) + (t/is (contains? xs 100))) + ;; Check y-coordinates of corners + (let [ys (set (map :y points))] + (t/is (contains? ys 0)) + (t/is (contains? ys 100))) + ;; Center point should have x=50 and y=50 + (let [centers (filter #(and (mth/close? 50 (:x %)) (mth/close? 50 (:y %))) points)] + (t/is (= 1 (count centers)))))) + + (t/testing "nil rect returns nil" + (t/is (nil? (gsn/rect->snap-points nil))))) + +(t/deftest shape->snap-points-test + (t/testing "Non-frame shape returns points + center" + (let [points [(gpt/point 10 20) (gpt/point 110 20) + (gpt/point 110 70) (gpt/point 10 70)] + shape {:type :rect + :points points + :selrect (grc/make-rect 10 20 100 50) + :transform (gmt/matrix)} + snap-pts (gsn/shape->snap-points shape)] + (t/is (set? snap-pts)) + ;; At minimum, 4 corner points + 1 center = 5 + (t/is (>= (count snap-pts) 5))))) + +(t/deftest guide->snap-points-test + (t/testing "Guide on x-axis returns point at position" + (let [guide {:axis :x :position 100} + frame nil + points (gsn/guide->snap-points guide frame)] + (t/is (= 1 (count points))) + (t/is (mth/close? 100 (:x (first points)))) + (t/is (mth/close? 0 (:y (first points)))))) + + (t/testing "Guide on y-axis returns point at position" + (let [guide {:axis :y :position 200} + frame nil + points (gsn/guide->snap-points guide frame)] + (t/is (= 1 (count points))) + (t/is (mth/close? 0 (:x (first points)))) + (t/is (mth/close? 200 (:y (first points))))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index 2608c12c1b..8682ded4ba 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -12,9 +12,22 @@ [common-tests.data-test] [common-tests.files-changes-test] [common-tests.files-migrations-test] + [common-tests.geom-align-test] [common-tests.geom-bounds-map-test] + [common-tests.geom-grid-test] + [common-tests.geom-line-test] + [common-tests.geom-modif-tree-test] [common-tests.geom-point-test] + [common-tests.geom-proportions-test] + [common-tests.geom-shapes-common-test] + [common-tests.geom-shapes-corners-test] + [common-tests.geom-shapes-effects-test] + [common-tests.geom-shapes-intersect-test] + [common-tests.geom-shapes-strokes-test] [common-tests.geom-shapes-test] + [common-tests.geom-shapes-text-test] + [common-tests.geom-shapes-tree-seq-test] + [common-tests.geom-snap-test] [common-tests.geom-test] [common-tests.logic.chained-propagation-test] [common-tests.logic.comp-creation-test] @@ -67,9 +80,22 @@ 'common-tests.data-test 'common-tests.files-changes-test 'common-tests.files-migrations-test + 'common-tests.geom-align-test 'common-tests.geom-bounds-map-test + 'common-tests.geom-grid-test + 'common-tests.geom-line-test + 'common-tests.geom-modif-tree-test 'common-tests.geom-point-test + 'common-tests.geom-proportions-test + 'common-tests.geom-shapes-common-test + 'common-tests.geom-shapes-corners-test + 'common-tests.geom-shapes-effects-test + 'common-tests.geom-shapes-intersect-test + 'common-tests.geom-shapes-strokes-test 'common-tests.geom-shapes-test + 'common-tests.geom-shapes-text-test + 'common-tests.geom-shapes-tree-seq-test + 'common-tests.geom-snap-test 'common-tests.geom-test 'common-tests.logic.chained-propagation-test 'common-tests.logic.comp-creation-test