CalvinBackup/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-04-11 05:43:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/main' into staging

Browse Source
This commit is contained in:
Andrey Antukh
2026-04-07 19:23:37 +02:00
parent e99b6ec213 f8c04949e1
commit a27ef26279
39 changed files with 2414 additions and 179 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
backend/src/app/tasks/telemetry.clj
View File

@@ -129,6 +129,12 @@
(->> [sql:team-averages]
(db/exec-one! conn)))
(defn- get-email-domains
[conn]
(let [sql "SELECT DISTINCT split_part(email, '@', 2) AS domain FROM profile ORDER BY 1"]
(->> (db/exec! conn [sql])
(mapv :domain))))
(defn- get-enabled-auth-providers
[conn]
(let [sql (str "SELECT auth_backend AS backend, count(*) AS total "
@@ -192,7 +198,8 @@
:total-fonts (get-num-fonts conn)
:total-comments (get-num-comments conn)
:total-file-changes (get-num-file-changes conn)
:total-touched-files (get-num-touched-files conn)}
:total-touched-files (get-num-touched-files conn)
:email-domains (get-email-domains conn)}
(merge
(get-team-averages conn)
(get-jvm-stats)

4
backend/test/backend_tests/tasks_telemetry_test.clj
View File

@@ -42,4 +42,6 @@
(t/is (contains? data :avg-files-on-project))
(t/is (contains? data :max-projects-on-team))
(t/is (contains? data :avg-files-on-project))
(t/is (contains? data :version))))))
(t/is (contains? data :version))
(t/is (contains? data :email-domains))
(t/is (= ["nodomain.com"] (:email-domains data)))))))

3
common/src/app/common/files/helpers.cljc
View File

@@ -355,7 +355,8 @@
prt (get objects pid)
shapes (:shapes prt)
pos (d/index-of shapes id)]
(if (= 0 pos) nil (nth shapes (dec pos)))))
(when (and (some? pos) (pos? pos))
(nth shapes (dec pos)))))
(defn get-immediate-children
"Retrieve resolved shape objects that are immediate children

124
common/src/app/common/types/path.cljc
View File

@@ -191,19 +191,129 @@
(defn get-points
"Returns points for the given content. Accepts PathData instances or
plain segment vectors. Returns nil for nil content."
plain segment vectors."
[content]
(when (some? content)
(let [content (if (impl/path-data? content)
content
(impl/path-data content))]
(segment/get-points content))))
(let [content (impl/path-data content)]
(segment/get-points content)))
(defn calc-selrect
"Calculate selrect from a content. The content can be in a PathData
instance or plain vector of segments."
[content]
(segment/content->selrect content))
(let [content (impl/path-data content)]
(segment/content->selrect content)))
(defn get-handlers
"Retrieve a map where for every point will retrieve a list of the
handlers that are associated with that point.
point -> [[index, prefix]]"
[content]
(let [content (impl/path-data content)]
(segment/get-handlers content)))
(defn get-handler-point
"Given a content, segment index and prefix, get a handler point."
[content index prefix]
(let [content (impl/path-data content)]
(segment/get-handler-point content index prefix)))
(defn get-handler
"Given a segment (command map) and a prefix, returns the handler
coordinate map {:x ... :y ...} from its params, or nil when absent."
[command prefix]
(segment/get-handler command prefix))
(defn handler->node
"Given a content, index and prefix, returns the path node (anchor
point) that the handler belongs to."
[content index prefix]
(let [content (impl/path-data content)]
(segment/handler->node content index prefix)))
(defn opposite-index
"Calculates the opposite handler index given a content, index and
prefix."
[content index prefix]
(let [content (impl/path-data content)]
(segment/opposite-index content index prefix)))
(defn point-indices
"Returns the indices of all segments whose endpoint matches point."
[content point]
(let [content (impl/path-data content)]
(segment/point-indices content point)))
(defn handler-indices
"Returns [[index prefix] ...] of all handlers associated with point."
[content point]
(let [content (impl/path-data content)]
(segment/handler-indices content point)))
(defn next-node
"Calculates the next node segment to be inserted when drawing."
[content position prev-point prev-handler]
(let [content (impl/path-data content)]
(segment/next-node content position prev-point prev-handler)))
(defn append-segment
"Appends a segment to content, accepting PathData or plain vector."
[content segment]
(let [content (impl/path-data content)]
(segment/append-segment content segment)))
(defn points->content
"Given a vector of points generate a path content."
[points & {:keys [close]}]
(segment/points->content points :close close))
(defn closest-point
"Returns the closest point in the path to position, at a given precision."
[content position precision]
(let [content (impl/path-data content)]
(when (pos? (count content))
(segment/closest-point content position precision))))
(defn make-corner-point
"Changes the content to make a point a corner."
[content point]
(let [content (impl/path-data content)]
(segment/make-corner-point content point)))
(defn make-curve-point
"Changes the content to make a point a curve."
[content point]
(let [content (impl/path-data content)]
(segment/make-curve-point content point)))
(defn split-segments
"Given a content, splits segments between points with new segments."
[content points value]
(let [content (impl/path-data content)]
(segment/split-segments content points value)))
(defn remove-nodes
"Removes the given points from content, reconstructing paths as needed."
[content points]
(let [content (impl/path-data content)]
(segment/remove-nodes content points)))
(defn merge-nodes
"Reduces contiguous segments at the given points to a single point."
[content points]
(let [content (impl/path-data content)]
(segment/merge-nodes content points)))
(defn join-nodes
"Creates new segments between points that weren't previously connected."
[content points]
(let [content (impl/path-data content)]
(segment/join-nodes content points)))
(defn separate-nodes
"Removes the segments between the given points."
[content points]
(let [content (impl/path-data content)]
(segment/separate-nodes content points)))
(defn- calc-bool-content*
"Calculate the boolean content from shape and objects. Returns plain

11
common/src/app/common/types/path/segment.cljc
View File

@@ -19,7 +19,7 @@
#?(:clj (set! *warn-on-reflection* true))
(defn update-handler
(defn- update-handler
[command prefix point]
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
(-> command
@@ -127,11 +127,6 @@
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn get-points
"Returns points for the given segment, faster version of
@@ -178,8 +173,6 @@
(conj result [prev-point last-start]))))
(def ^:const path-closest-point-accuracy 0.01)
;; FIXME: move to helpers?, this function need performance review, it
;; is executed so many times on path edition
(defn- curve-closest-point
@@ -787,7 +780,7 @@
(let [transform (gmt/translate-matrix move-vec)]
(transform-content content transform)))
(defn calculate-extremities
(defn- calculate-extremities
"Calculate extremities for the provided content"
[content]
(loop [points (transient #{})

17
common/test/common_tests/files/helpers_test.cljc
View File

@@ -7,6 +7,7 @@
(ns common-tests.files.helpers-test
(:require
[app.common.files.helpers :as cfh]
[app.common.uuid :as uuid]
[clojure.test :as t]))
(t/deftest test-generate-unique-name
@@ -36,3 +37,19 @@
#{"base-name 1" "base-name 2"}
:immediate-suffix? true)
"base-name 3")))
(t/deftest test-get-prev-sibling
(let [parent-id (uuid/custom 1 1)
child-a (uuid/custom 1 2)
child-b (uuid/custom 1 3)
orphan-id (uuid/custom 1 4)
objects {parent-id {:id parent-id :shapes [child-a child-b]}
child-a {:id child-a :parent-id parent-id}
child-b {:id child-b :parent-id parent-id}
orphan-id {:id orphan-id :parent-id parent-id}}]
(t/testing "Returns previous sibling when present in parent ordering"
(t/is (= child-a
(cfh/get-prev-sibling objects child-b))))
(t/testing "Returns nil when the shape is missing from parent ordering"
(t/is (nil? (cfh/get-prev-sibling objects orphan-id))))))

96
common/test/common_tests/geom_align_test.cljc Normal file
View File

@@ -0,0 +1,96 @@
;; 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.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)))))

416
common/test/common_tests/geom_bounds_map_test.cljc Normal file
View File

@@ -0,0 +1,416 @@
;; 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-bounds-map-test
(:require
[app.common.geom.bounds-map :as gbm]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.points :as gpo]
[app.common.math :as mth]
[app.common.types.modifiers :as ctm]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[clojure.test :as t]))
;; ---- Helpers ----
(defn- make-rect
"Create a minimal rect shape with given id and position/size."
[id x y w h]
(-> (cts/setup-shape {:id id
:type :rect
:name (str "rect-" id)
:x x
:y y
:width w
:height h})
(assoc :parent-id uuid/zero
:frame-id uuid/zero)))
(defn- make-group
"Create a minimal group shape with given id and children ids."
[id child-ids]
(let [x 0 y 0 w 100 h 100]
(-> (cts/setup-shape {:id id
:type :group
:name (str "group-" id)
:x x
:y y
:width w
:height h})
(assoc :parent-id uuid/zero
:frame-id uuid/zero
:shapes (vec child-ids)))))
(defn- make-masked-group
"Create a masked group shape with given id and children ids."
[id child-ids]
(let [x 0 y 0 w 100 h 100]
(-> (cts/setup-shape {:id id
:type :group
:name (str "masked-group-" id)
:x x
:y y
:width w
:height h})
(assoc :parent-id uuid/zero
:frame-id uuid/zero
:masked-group true
:shapes (vec child-ids)))))
(defn- make-objects
"Build an objects map from shapes. Sets parent-id on children."
[shapes]
(let [shape-map (into {} (map (fn [s] [(:id s) s]) shapes))]
;; Set parent-id on children based on their container's :shapes list
(reduce-kv (fn [m _id shape]
(if (contains? shape :shapes)
(reduce (fn [m' child-id]
(assoc-in m' [child-id :parent-id] (:id shape)))
m
(:shapes shape))
m))
shape-map
shape-map)))
;; ---- Tests for objects->bounds-map ----
(t/deftest objects->bounds-map-empty-test
(t/testing "Empty objects returns empty map"
(let [result (gbm/objects->bounds-map {})]
(t/is (map? result))
(t/is (empty? result)))))
(t/deftest objects->bounds-map-single-rect-test
(t/testing "Single rect produces bounds entry"
(let [id (uuid/next)
shape (make-rect id 10 20 30 40)
objects {id shape}
bm (gbm/objects->bounds-map objects)]
(t/is (contains? bm id))
(t/is (delay? (get bm id)))
(let [bounds @(get bm id)]
(t/is (vector? bounds))
(t/is (= 4 (count bounds)))
;; Verify bounds match the rect's geometry
(t/is (mth/close? 10.0 (:x (gpo/origin bounds))))
(t/is (mth/close? 20.0 (:y (gpo/origin bounds))))
(t/is (mth/close? 30.0 (gpo/width-points bounds)))
(t/is (mth/close? 40.0 (gpo/height-points bounds)))))))
(t/deftest objects->bounds-map-multiple-rects-test
(t/testing "Multiple rects each produce correct bounds"
(let [id1 (uuid/next)
id2 (uuid/next)
id3 (uuid/next)
objects {id1 (make-rect id1 0 0 100 50)
id2 (make-rect id2 50 25 200 75)
id3 (make-rect id3 10 10 1 1)}
bm (gbm/objects->bounds-map objects)]
(t/is (= 3 (count bm)))
(doseq [id [id1 id2 id3]]
(t/is (contains? bm id))
(t/is (delay? (get bm id))))
;; Check each shape's bounds
(let [b1 @(get bm id1)]
(t/is (mth/close? 0.0 (:x (gpo/origin b1))))
(t/is (mth/close? 0.0 (:y (gpo/origin b1))))
(t/is (mth/close? 100.0 (gpo/width-points b1)))
(t/is (mth/close? 50.0 (gpo/height-points b1))))
(let [b2 @(get bm id2)]
(t/is (mth/close? 50.0 (:x (gpo/origin b2))))
(t/is (mth/close? 25.0 (:y (gpo/origin b2))))
(t/is (mth/close? 200.0 (gpo/width-points b2)))
(t/is (mth/close? 75.0 (gpo/height-points b2))))
(let [b3 @(get bm id3)]
(t/is (mth/close? 10.0 (:x (gpo/origin b3))))
(t/is (mth/close? 10.0 (:y (gpo/origin b3))))))))
(t/deftest objects->bounds-map-laziness-test
(t/testing "Bounds are computed lazily (delay semantics)"
(let [id1 (uuid/next)
id2 (uuid/next)
objects {id1 (make-rect id1 0 0 10 10)
id2 (make-rect id2 5 5 20 20)}
bm (gbm/objects->bounds-map objects)]
;; Delays should not be realized until deref'd
(t/is (not (realized? (get bm id1))))
(t/is (not (realized? (get bm id2))))
;; After deref, they should be realized
@(get bm id1)
(t/is (realized? (get bm id1)))
(t/is (not (realized? (get bm id2))))
@(get bm id2)
(t/is (realized? (get bm id2))))))
;; ---- Tests for transform-bounds-map ----
(t/deftest transform-bounds-map-empty-modif-tree-test
(t/testing "Empty modif-tree returns equivalent bounds-map"
(let [id1 (uuid/next)
objects {id1 (make-rect id1 10 20 30 40)}
bm (gbm/objects->bounds-map objects)
result (gbm/transform-bounds-map bm objects {})]
;; No modifiers means no IDs to resolve, so bounds-map should be returned as-is
(t/is (= bm result)))))
(t/deftest transform-bounds-map-move-rect-test
(t/testing "Moving a rect updates its bounds"
(let [id1 (uuid/next)
objects {id1 (make-rect id1 10 20 30 40)}
bm (gbm/objects->bounds-map objects)
modif-tree {id1 {:modifiers (ctm/move-modifiers (gpt/point 100 200))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
(t/is (contains? result id1))
(let [old-bounds @(get bm id1)
new-bounds @(get result id1)]
;; Original bounds should be unchanged
(t/is (mth/close? 10.0 (:x (gpo/origin old-bounds))))
(t/is (mth/close? 20.0 (:y (gpo/origin old-bounds))))
;; New bounds should be translated
(t/is (mth/close? 110.0 (:x (gpo/origin new-bounds))))
(t/is (mth/close? 220.0 (:y (gpo/origin new-bounds))))))))
(t/deftest transform-bounds-map-move-in-group-test
(t/testing "Moving a child rect also updates its parent group bounds"
(let [child-id (uuid/next)
group-id (uuid/next)
child (make-rect child-id 10 10 20 20)
group (make-group group-id [child-id])
objects (make-objects [child group])
bm (gbm/objects->bounds-map objects)
;; Move child by (50, 50)
modif-tree {child-id {:modifiers (ctm/move-modifiers (gpt/point 50 50))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
;; Both child and group should have new bounds
(t/is (contains? result child-id))
(t/is (contains? result group-id))
(let [new-child-bounds @(get result child-id)]
(t/is (mth/close? 60.0 (:x (gpo/origin new-child-bounds))))
(t/is (mth/close? 60.0 (:y (gpo/origin new-child-bounds)))))
(let [new-group-bounds @(get result group-id)]
;; Group bounds should encompass the moved child
(t/is (some? new-group-bounds))))))
(t/deftest transform-bounds-map-masked-group-test
(t/testing "Masked group only uses first child for bounds"
(let [child1-id (uuid/next)
child2-id (uuid/next)
group-id (uuid/next)
child1 (make-rect child1-id 0 0 10 10)
child2 (make-rect child2-id 100 100 50 50)
group (make-masked-group group-id [child1-id child2-id])
objects (make-objects [child1 child2 group])
bm (gbm/objects->bounds-map objects)
result (gbm/transform-bounds-map bm objects {})]
;; Even with empty modif-tree, the group should be resolved
;; Masked group behavior: only first child contributes
(t/is (some? result)))))
(t/deftest transform-bounds-map-multiple-modifiers-test
(t/testing "Multiple shapes modified at once"
(let [id1 (uuid/next)
id2 (uuid/next)
objects {id1 (make-rect id1 0 0 100 100)
id2 (make-rect id2 200 200 50 50)}
bm (gbm/objects->bounds-map objects)
modif-tree {id1 {:modifiers (ctm/move-modifiers (gpt/point 10 10))}
id2 {:modifiers (ctm/move-modifiers (gpt/point -5 -5))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
(let [b1 @(get result id1)]
(t/is (mth/close? 10.0 (:x (gpo/origin b1))))
(t/is (mth/close? 10.0 (:y (gpo/origin b1)))))
(let [b2 @(get result id2)]
(t/is (mth/close? 195.0 (:x (gpo/origin b2))))
(t/is (mth/close? 195.0 (:y (gpo/origin b2))))))))
(t/deftest transform-bounds-map-uuid-zero-ignored-test
(t/testing "uuid/zero in modif-tree is skipped when creating new bounds entries"
(let [id1 (uuid/next)
objects {id1 (make-rect id1 10 20 30 40)
uuid/zero {:id uuid/zero :type :frame :parent-id uuid/zero}}
bm (gbm/objects->bounds-map objects)
;; uuid/zero in modif-tree triggers resolve but its entry is preserved from original
modif-tree {id1 {:modifiers (ctm/move-modifiers (gpt/point 0 0))}
uuid/zero {:modifiers (ctm/move-modifiers (gpt/point 0 0))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
;; uuid/zero may still be in result if it was in the original bounds-map
;; The function does not add NEW uuid/zero entries, but preserves existing ones
(when (contains? bm uuid/zero)
(t/is (contains? result uuid/zero))))))
(t/deftest transform-bounds-map-explicit-ids-test
(t/testing "Passing explicit ids limits which shapes are recomputed"
(let [id1 (uuid/next)
id2 (uuid/next)
objects {id1 (make-rect id1 0 0 100 100)
id2 (make-rect id2 200 200 50 50)}
bm (gbm/objects->bounds-map objects)
modif-tree {id1 {:modifiers (ctm/move-modifiers (gpt/point 10 10))}
id2 {:modifiers (ctm/move-modifiers (gpt/point 20 20))}}
;; Only recompute id1
result (gbm/transform-bounds-map bm objects modif-tree #{id1})]
;; id1 should be updated
(let [b1 @(get result id1)]
(t/is (mth/close? 10.0 (:x (gpo/origin b1)))))
;; id2 should be preserved from original bounds-map
(let [b2-original @(get bm id2)
b2-result @(get result id2)]
(t/is (= b2-original b2-result))))))
(t/deftest transform-bounds-map-nested-groups-test
(t/testing "Nested groups propagate bounds updates upward"
(let [child-id (uuid/next)
inner-grp (uuid/next)
outer-grp (uuid/next)
child (make-rect child-id 0 0 20 20)
inner (make-group inner-grp [child-id])
outer (make-group outer-grp [inner-grp])
objects (make-objects [child inner outer])
bm (gbm/objects->bounds-map objects)
modif-tree {child-id {:modifiers (ctm/move-modifiers (gpt/point 100 100))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
;; All three should be in the result
(t/is (contains? result child-id))
(t/is (contains? result inner-grp))
(t/is (contains? result outer-grp))
(let [child-bounds @(get result child-id)]
(t/is (mth/close? 100.0 (:x (gpo/origin child-bounds))))
(t/is (mth/close? 100.0 (:y (gpo/origin child-bounds))))))))
;; ---- Tests for bounds-map (debug function) ----
(t/deftest bounds-map-debug-empty-test
(t/testing "Debug bounds-map with empty inputs returns empty map"
(let [result (gbm/bounds-map {} {})]
(t/is (map? result))
(t/is (empty? result)))))
(t/deftest bounds-map-debug-single-shape-test
(t/testing "Debug bounds-map returns readable entries for shapes"
(let [id (uuid/next)
shape (make-rect id 10 20 30 40)
objects {id shape}
bm (gbm/objects->bounds-map objects)
result (gbm/bounds-map objects bm)
expected-name (str "rect-" id)]
(t/is (contains? result expected-name))
(let [entry (get result expected-name)]
(t/is (map? entry))
(t/is (contains? entry :x))
(t/is (contains? entry :y))
(t/is (contains? entry :width))
(t/is (contains? entry :height))
(t/is (mth/close? 10.0 (:x entry)))
(t/is (mth/close? 20.0 (:y entry)))
(t/is (mth/close? 30.0 (:width entry)))
(t/is (mth/close? 40.0 (:height entry)))))))
(t/deftest bounds-map-debug-missing-shape-test
(t/testing "Debug bounds-map skips entries where shape is nil"
(let [fake-id (uuid/next)
real-id (uuid/next)
objects {real-id (make-rect real-id 10 20 30 40)}
real-bm (gbm/objects->bounds-map objects)
;; Bounds map has an entry for fake-id (delay with valid points)
;; but no shape in objects for fake-id
bm {fake-id (delay [(gpt/point 0 0)
(gpt/point 10 0)
(gpt/point 10 10)
(gpt/point 0 10)])
real-id (get real-bm real-id)}
result (gbm/bounds-map objects bm)]
;; fake-id has no shape in objects, so it should be excluded
(t/is (not (contains? result (str fake-id))))
;; real-id has a shape, so it should be present
(t/is (contains? result (str "rect-" real-id))))))
(t/deftest bounds-map-debug-multiple-shapes-test
(t/testing "Debug bounds-map with multiple shapes"
(let [id1 (uuid/next)
id2 (uuid/next)
objects {id1 (make-rect id1 0 0 50 50)
id2 (make-rect id2 100 100 25 25)}
bm (gbm/objects->bounds-map objects)
result (gbm/bounds-map objects bm)]
(t/is (>= (count result) 2)))))
(t/deftest bounds-map-debug-rounds-values-test
(t/testing "Debug bounds-map rounds x/y/width/height to 2 decimal places"
(let [id (uuid/next)
objects {id (make-rect id 10.123456 20.987654 30.5555 40.4444)}
bm (gbm/objects->bounds-map objects)
result (gbm/bounds-map objects bm)
entry (get result (str "rect-" id))]
(when (some? entry)
(t/is (number? (:x entry)))
(t/is (number? (:y entry)))
(t/is (number? (:width entry)))
(t/is (number? (:height entry)))))))
;; ---- Edge cases ----
(t/deftest objects->bounds-map-shape-with-identity-transform-test
(t/testing "Shape with identity transform uses selrect-based points"
(let [id (uuid/next)
shape (make-rect id 5 15 25 35)
objects {id shape}
bm (gbm/objects->bounds-map objects)]
(t/is (contains? bm id))
(let [bounds @(get bm id)]
(t/is (= 4 (count bounds)))
;; All points should have valid coordinates
(doseq [p bounds]
(t/is (number? (:x p)))
(t/is (number? (:y p))))))))
(t/deftest transform-bounds-map-unchanged-unmodified-shapes-test
(t/testing "Unmodified shapes keep their original bounds reference"
(let [id1 (uuid/next)
id2 (uuid/next)
objects {id1 (make-rect id1 0 0 100 100)
id2 (make-rect id2 200 200 50 50)}
bm (gbm/objects->bounds-map objects)
;; Only modify id1
modif-tree {id1 {:modifiers (ctm/move-modifiers (gpt/point 10 10))}}
result (gbm/transform-bounds-map bm objects modif-tree)
old-b1 @(get bm id1)
new-b1 @(get result id1)]
;; id1 should have different bounds
(t/is (not (mth/close? (:x (gpo/origin old-b1))
(:x (gpo/origin new-b1))))))))
(t/deftest transform-bounds-map-deep-nesting-test
(t/testing "3-level nesting of groups with a leaf modification"
(let [leaf-id (uuid/next)
grp1-id (uuid/next)
grp2-id (uuid/next)
grp3-id (uuid/next)
leaf (make-rect leaf-id 0 0 10 10)
grp1 (make-group grp1-id [leaf-id])
grp2 (make-group grp2-id [grp1-id])
grp3 (make-group grp3-id [grp2-id])
objects (make-objects [leaf grp1 grp2 grp3])
bm (gbm/objects->bounds-map objects)
modif-tree {leaf-id {:modifiers (ctm/move-modifiers (gpt/point 5 5))}}
result (gbm/transform-bounds-map bm objects modif-tree)]
;; All group levels should be recomputed
(t/is (contains? result leaf-id))
(t/is (contains? result grp1-id))
(t/is (contains? result grp2-id))
(t/is (contains? result grp3-id)))))
(t/deftest objects->bounds-map-zero-sized-rect-test
(t/testing "Zero-sized rect produces valid bounds (clamped to 0.01)"
(let [id (uuid/next)
shape (make-rect id 10 20 0 0)
objects {id shape}
bm (gbm/objects->bounds-map objects)]
(t/is (contains? bm id))
(let [bounds @(get bm id)]
;; Width and height should be clamped to at least 0.01
(t/is (>= (gpo/width-points bounds) 0.01))
(t/is (>= (gpo/height-points bounds) 0.01))))))

100
common/test/common_tests/geom_grid_test.cljc Normal file
View File

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

64
common/test/common_tests/geom_line_test.cljc Normal file
View File

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

77
common/test/common_tests/geom_modif_tree_test.cljc Normal file
View File

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

2
common/test/common_tests/geom_modifiers_test.cljc
View File

@@ -8,7 +8,6 @@
(:require
[app.common.geom.modifiers :as gm]
[app.common.geom.point :as gpt]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
@@ -64,7 +63,6 @@
(add-rect-child :rect1 :frame1))
page (thf/current-page file)
objects (:objects page)
frame-id (thi/id :frame1)
rect-id (thi/id :rect1)
;; Create a move modifier for the rectangle

77
common/test/common_tests/geom_proportions_test.cljc Normal file
View File

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

136
common/test/common_tests/geom_shapes_common_test.cljc Normal file
View File

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

102
common/test/common_tests/geom_shapes_corners_test.cljc Normal file
View File

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

74
common/test/common_tests/geom_shapes_effects_test.cljc Normal file
View File

@@ -0,0 +1,74 @@
;; 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]
[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]))))))

258
common/test/common_tests/geom_shapes_intersect_test.cljc Normal file
View File

@@ -0,0 +1,258 @@
;; 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.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)))))))

48
common/test/common_tests/geom_shapes_strokes_test.cljc Normal file
View File

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

76
common/test/common_tests/geom_shapes_text_test.cljc Normal file
View File

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

117
common/test/common_tests/geom_shapes_tree_seq_test.cljc Normal file
View File

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

72
common/test/common_tests/geom_snap_test.cljc Normal file
View File

@@ -0,0 +1,72 @@
;; 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.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)))))))

32
common/test/common_tests/runner.cljc
View File

@@ -12,9 +12,23 @@
[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-modifiers-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]
@@ -69,9 +83,23 @@
'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-modifiers-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
@@ -95,7 +123,6 @@
'common-tests.svg-test
'common-tests.text-test
'common-tests.time-test
'common-tests.undo-stack-test
'common-tests.types.absorb-assets-test
'common-tests.types.components-test
'common-tests.types.container-test
@@ -106,6 +133,7 @@
'common-tests.types.shape-decode-encode-test
'common-tests.types.shape-interactions-test
'common-tests.types.shape-layout-test
'common-tests.types.tokens-lib-test
'common-tests.types.token-test
'common-tests.types.tokens-lib-test
'common-tests.undo-stack-test
'common-tests.uuid-test))

111
common/test/common_tests/types/path_data_test.cljc
View File

@@ -273,8 +273,8 @@
(t/is (= result2 result3))))
(t/deftest path-get-points-nil-safe
(t/testing "path/get-points returns nil for nil content without throwing"
(t/is (nil? (path/get-points nil))))
(t/testing "path/get-points returns empty for nil content without throwing"
(t/is (empty? (path/get-points nil))))
(t/testing "path/get-points returns correct points for valid content"
(let [content (path/content sample-content)
points (path/get-points content)]
@@ -325,18 +325,12 @@
(let [pdata (path/content sample-content)
result1 (calculate-extremities sample-content)
result2 (calculate-extremities pdata)
result3 (path.segment/calculate-extremities sample-content)
result4 (path.segment/calculate-extremities pdata)
expect #{(gpt/point 480.0 839.0)
(gpt/point 439.0 802.0)
(gpt/point 264.0 634.0)}
n-iter 100000]
(gpt/point 264.0 634.0)}]
(t/is (= result1 result3))
(t/is (= result1 expect))
(t/is (= result2 expect))
(t/is (= result3 expect))
(t/is (= result4 expect))))
(t/is (= result2 expect))))
(def sample-content-2
[{:command :move-to, :params {:x 480.0, :y 839.0}}
@@ -346,21 +340,17 @@
{:command :close-path :params {}}])
(t/deftest extremities-2
(let [result1 (path.segment/calculate-extremities sample-content-2)
result2 (calculate-extremities sample-content-2)]
(t/is (= result1 result2))))
(let [result1 (calculate-extremities sample-content-2)]
(t/is (some? result1))))
(t/deftest extremities-3
(let [segments [{:command :move-to, :params {:x -310.5355224609375, :y 452.62115478515625}}]
content (path/content segments)
result1 (calculate-extremities segments)
result2 (path.segment/calculate-extremities segments)
result3 (path.segment/calculate-extremities content)
result2 (calculate-extremities content)
expect #{}]
(t/is (= result1 expect))
(t/is (= result1 expect))
(t/is (= result2 expect))
(t/is (= result3 expect))))
(t/is (= result2 expect))))
(t/deftest points-to-content
(let [initial [(gpt/point 0.0 0.0)
@@ -926,17 +916,9 @@
(t/is (some? e))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SEGMENT UNTESTED FUNCTIONS
;; SEGMENT FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest segment-update-handler
(let [cmd {:command :curve-to
:params {:x 10.0 :y 0.0 :c1x 0.0 :c1y 0.0 :c2x 0.0 :c2y 0.0}}
pt (gpt/point 3.0 5.0)
r (path.segment/update-handler cmd :c1 pt)]
(t/is (= 3.0 (get-in r [:params :c1x])))
(t/is (= 5.0 (get-in r [:params :c1y])))))
(t/deftest segment-get-handler
(let [cmd {:command :curve-to
:params {:x 10.0 :y 0.0 :c1x 3.0 :c1y 5.0 :c2x 7.0 :c2y 2.0}}]
@@ -960,13 +942,6 @@
(t/is (mth/close? 2.0 (:x opp)))
(t/is (mth/close? 5.0 (:y opp)))))
(t/deftest segment-opposite-handler
(let [pt (gpt/point 5.0 5.0)
h (gpt/point 8.0 5.0)
opp (path.segment/opposite-handler pt h)]
(t/is (mth/close? 2.0 (:x opp)))
(t/is (mth/close? 5.0 (:y opp)))))
(t/deftest segment-point-indices
(let [content (path/content sample-content-2)
pt (gpt/point 480.0 839.0)
@@ -1139,6 +1114,74 @@
(t/is (mth/close? (+ 480.0 5.0) (get-in first-seg [:params :x])))
(t/is (mth/close? (+ 839.0 3.0) (get-in first-seg [:params :y])))))
(t/deftest path-handler-indices
(t/testing "handler-indices returns expected handlers for a curve point"
(let [content (path/content sample-content-2)
;; point at index 2 is (4.0, 4.0), which is a curve-to endpoint
pt (gpt/point 4.0 4.0)
result (path/handler-indices content pt)]
;; The :c2 handler of index 2 belongs to point (4.0, 4.0)
;; The :c1 handler of index 3 also belongs to point (4.0, 4.0)
(t/is (some? result))
(t/is (pos? (count result)))
(t/is (every? (fn [[idx prefix]]
(and (number? idx)
(#{:c1 :c2} prefix)))
result))))
(t/testing "handler-indices returns empty for a point with no associated handlers"
(let [content (path/content sample-content-2)
;; (480.0, 839.0) is the move-to at index 0; since index 1
;; is a line-to (not a curve-to), there is no :c1 handler
;; for this point.
pt (gpt/point 480.0 839.0)
result (path/handler-indices content pt)]
(t/is (empty? result))))
(t/testing "handler-indices with nil content returns empty"
(let [result (path/handler-indices nil (gpt/point 0 0))]
(t/is (empty? result)))))
(t/deftest path-closest-point
(t/testing "closest-point on a line segment"
(let [content (path/content simple-open-content)
;; simple-open-content: (0,0)->(10,0)->(10,10)
;; Query a point near the first segment
pos (gpt/point 5.0 1.0)
result (path/closest-point content pos 0.01)]
(t/is (some? result))
;; Closest point on line (0,0)->(10,0) to (5,1) should be near (5,0)
(t/is (mth/close? 5.0 (:x result) 0.5))
(t/is (mth/close? 0.0 (:y result) 0.5))))
(t/testing "closest-point on nil content returns nil"
(let [result (path/closest-point nil (gpt/point 5.0 5.0) 0.01)]
(t/is (nil? result)))))
(t/deftest path-make-curve-point
(t/testing "make-curve-point converts a line-to point into a curve"
(let [content (path/content simple-open-content)
;; The midpoint (10,0) is reached via :line-to
pt (gpt/point 10.0 0.0)
result (path/make-curve-point content pt)
segs (vec result)]
(t/is (some? result))
;; After making (10,0) a curve, we expect at least one :curve-to
(t/is (some #(= :curve-to (:command %)) segs)))))
(t/deftest path-merge-nodes
(t/testing "merge-nodes reduces segments at contiguous points"
(let [content (path/content simple-open-content)
;; Merge the midpoint (10,0) — should reduce segment count
pts #{(gpt/point 10.0 0.0)}
result (path/merge-nodes content pts)]
(t/is (some? result))
(t/is (<= (count result) (count simple-open-content)))))
(t/testing "merge-nodes with empty points returns same content"
(let [content (path/content simple-open-content)
result (path/merge-nodes content #{})]
(t/is (= (count result) (count simple-open-content)))))
(t/testing "merge-nodes with nil content does not throw"
(let [result (path/merge-nodes nil #{(gpt/point 0 0)})]
(t/is (some? result)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BOOL OPERATIONS — INTERSECTION / DIFFERENCE / EXCLUSION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

188
common/test/common_tests/types/shape_interactions_test.cljc
View File

@@ -890,5 +890,191 @@
(t/is (= (:id frame4) (:destination (get new-interactions 0))))
(t/is (= (:id frame5) (:destination (get new-interactions 1))))
(t/is (= (:id frame3) (:destination (get new-interactions 2))))
(t/is (nil? (:destination (get new-interactions 3))))))))
(t/is (nil? (:destination (get new-interactions 3))))))
;; `nil` interactions is a valid input when a shape has no prototype links yet.
(t/testing "Remap nil interactions"
(t/is (nil? (ctsi/remap-interactions nil ids-map objects))))))
(t/deftest destination-predicates
(let [frame-id (uuid/next)
other-frame-id (uuid/next)
navigate (ctsi/set-destination ctsi/default-interaction frame-id)
open-overlay (-> ctsi/default-interaction
(ctsi/set-action-type :open-overlay)
(ctsi/set-destination frame-id))
close-overlay (-> ctsi/default-interaction
(ctsi/set-action-type :close-overlay)
(ctsi/set-destination frame-id))
prev-screen (ctsi/set-action-type ctsi/default-interaction :prev-screen)
navigate-without-id (assoc ctsi/default-interaction :destination nil)]
;; These helpers are consumed by flow code, so we verify both capability and exact target checks.
(t/testing "Destination helpers distinguish optional and concrete targets"
(t/is (ctsi/destination? navigate))
(t/is (ctsi/destination? open-overlay))
(t/is (ctsi/destination? close-overlay))
(t/is (not (ctsi/destination? navigate-without-id)))
(t/is (not (ctsi/destination? prev-screen))))
(t/testing "Destination match helpers are action aware"
(t/is (ctsi/dest-to? navigate frame-id))
(t/is (ctsi/dest-to? open-overlay frame-id))
(t/is (not (ctsi/dest-to? prev-screen frame-id)))
(t/is (not (ctsi/dest-to? navigate other-frame-id)))
(t/is (ctsi/navs-to? navigate frame-id))
(t/is (not (ctsi/navs-to? open-overlay frame-id)))
(t/is (not (ctsi/navs-to? navigate other-frame-id))))))
(t/deftest collection-predicates
(let [frame-id (uuid/next)
other-frame-id (uuid/next)
click-nav (ctsi/set-destination ctsi/default-interaction frame-id)
delayed-nav (-> ctsi/default-interaction
(assoc :destination frame-id)
(assoc :event-type :after-delay)
(assoc :delay 600))
overlay-flow (-> ctsi/default-interaction
(ctsi/set-action-type :open-overlay)
(ctsi/set-destination other-frame-id))
open-url (-> ctsi/default-interaction
(ctsi/set-action-type :open-url)
(ctsi/set-url "https://example.com"))
close-no-dest (ctsi/set-action-type ctsi/default-interaction :close-overlay)]
;; `actionable?` is intentionally narrow: only click interactions should mark the shape as clickable.
(t/testing "Actionable only considers click events"
(t/is (ctsi/actionable? [click-nav delayed-nav]))
(t/is (not (ctsi/actionable? [delayed-nav (assoc overlay-flow :event-type :mouse-enter)])))
(t/is (nil? (ctsi/actionable? nil))))
;; Flow helpers should only report interactions that can continue a prototype flow and have a destination.
(t/testing "Flow helpers only include destination based interactions"
(t/is (ctsi/flow-origin? [click-nav open-url]))
(t/is (ctsi/flow-origin? [overlay-flow close-no-dest click-nav]))
(t/is (not (ctsi/flow-origin? [open-url close-no-dest])))
(t/is (ctsi/flow-to? [click-nav overlay-flow] frame-id))
(t/is (ctsi/flow-to? [click-nav overlay-flow] other-frame-id))
(t/is (not (ctsi/flow-to? [open-url close-no-dest] frame-id)))
(t/is (nil? (ctsi/flow-to? nil frame-id))))))
(t/deftest remove-interactions-test
(let [frame-id (uuid/next)
keep-nav (ctsi/set-destination ctsi/default-interaction frame-id)
remove-url (-> ctsi/default-interaction
(ctsi/set-action-type :open-url)
(ctsi/set-url "https://example.com"))
remove-prev (ctsi/set-action-type ctsi/default-interaction :prev-screen)
interactions [keep-nav remove-url remove-prev]]
;; The helper should preserve vector semantics and normalize an empty result back to nil.
(t/testing "Remove only matching interactions"
(let [new-interactions (ctsi/remove-interactions #(= :open-url (:action-type %)) interactions)]
(t/is (= 2 (count new-interactions)))
(t/is (= [:navigate :prev-screen] (mapv :action-type new-interactions)))))
(t/testing "Remove all interactions returns nil"
(t/is (nil? (ctsi/remove-interactions (constantly true) interactions))))))
(t/deftest validation-guards
(let [frame (cts/setup-shape {:type :frame})
rect (cts/setup-shape {:type :rect})
frame-id (uuid/next)
overlay-frame (cts/setup-shape {:type :frame :width 30 :height 20})
base-frame (cts/setup-shape {:type :frame :width 100 :height 100})
objects {(:id base-frame) base-frame
(:id overlay-frame) overlay-frame}
after-delay (ctsi/set-event-type ctsi/default-interaction :after-delay frame)
overlay (-> ctsi/default-interaction
(ctsi/set-action-type :open-overlay)
(ctsi/set-destination (:id overlay-frame)))
open-url (ctsi/set-action-type ctsi/default-interaction :open-url)
dissolve (ctsi/set-animation-type ctsi/default-interaction :dissolve)
slide (ctsi/set-animation-type ctsi/default-interaction :slide)
push (ctsi/set-animation-type ctsi/default-interaction :push)]
;; These checks protect editor state from invalid combinations, so every public mutator should reject bad input.
(t/testing "Reject invalid event and action updates"
(t/is (ex/exception? (ex/try! (ctsi/set-event-type ctsi/default-interaction :bad-event rect))))
(t/is (ex/exception? (ex/try! (ctsi/set-action-type ctsi/default-interaction :bad-action)))))
(t/testing "Reject invalid delay, destination and preserve-scroll updates"
(t/is (ex/exception? (ex/try! (ctsi/set-delay ctsi/default-interaction 10))))
(t/is (ex/exception? (ex/try! (ctsi/set-delay after-delay :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-destination (ctsi/set-action-type ctsi/default-interaction :prev-screen) frame-id))))
(t/is (ex/exception? (ex/try! (ctsi/set-preserve-scroll (ctsi/set-action-type ctsi/default-interaction :prev-screen) true))))
(t/is (ex/exception? (ex/try! (ctsi/set-preserve-scroll ctsi/default-interaction :bad)))))
(t/testing "Reject invalid url and overlay option updates"
(t/is (ex/exception? (ex/try! (ctsi/set-url ctsi/default-interaction "https://example.com"))))
(t/is (ex/exception? (ex/try! (ctsi/set-url open-url :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-overlay-pos-type ctsi/default-interaction :center base-frame objects))))
(t/is (ex/exception? (ex/try! (ctsi/set-overlay-pos-type overlay :bad base-frame objects))))
(t/is (ex/exception? (ex/try! (ctsi/toggle-overlay-pos-type ctsi/default-interaction :center base-frame objects))))
(t/is (ex/exception? (ex/try! (ctsi/toggle-overlay-pos-type overlay :bad base-frame objects))))
(t/is (ex/exception? (ex/try! (ctsi/set-overlay-position ctsi/default-interaction (gpt/point 1 2)))))
(t/is (ex/exception? (ex/try! (ctsi/set-overlay-position overlay {:x 1 :y 2}))))
(t/is (ex/exception? (ex/try! (ctsi/set-close-click-outside ctsi/default-interaction true))))
(t/is (ex/exception? (ex/try! (ctsi/set-close-click-outside overlay :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-background-overlay ctsi/default-interaction true))))
(t/is (ex/exception? (ex/try! (ctsi/set-background-overlay overlay :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-position-relative-to ctsi/default-interaction frame-id))))
(t/is (ex/exception? (ex/try! (ctsi/set-position-relative-to overlay :bad)))))
(t/testing "Reject invalid animation updates"
(t/is (ex/exception? (ex/try! (ctsi/set-animation-type (ctsi/set-action-type ctsi/default-interaction :open-overlay) :push))))
(t/is (ex/exception? (ex/try! (ctsi/set-animation-type ctsi/default-interaction :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-animation-type (ctsi/set-action-type ctsi/default-interaction :prev-screen) :dissolve))))
(t/is (ex/exception? (ex/try! (ctsi/set-duration ctsi/default-interaction 100))))
(t/is (ex/exception? (ex/try! (ctsi/set-duration dissolve :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-easing ctsi/default-interaction :ease-in))))
(t/is (ex/exception? (ex/try! (ctsi/set-easing dissolve :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-way ctsi/default-interaction :in))))
(t/is (ex/exception? (ex/try! (ctsi/set-way slide :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-direction ctsi/default-interaction :left))))
(t/is (ex/exception? (ex/try! (ctsi/set-direction push :bad))))
(t/is (ex/exception? (ex/try! (ctsi/set-offset-effect ctsi/default-interaction true))))
(t/is (ex/exception? (ex/try! (ctsi/set-offset-effect slide :bad))))
(t/is (ex/exception? (ex/try! (ctsi/invert-direction {:direction :left})))))))
(t/deftest calc-overlay-position-edge-cases
(let [root-frame (cts/setup-shape {:id uuid/zero :type :frame :width 500 :height 500})
base-frame (cts/setup-shape {:type :frame :width 120 :height 120 :frame-id uuid/zero})
popup-frame (cts/setup-shape {:type :frame :width 80 :height 70 :x 20 :y 15 :frame-id (:id base-frame)})
trigger (cts/setup-shape {:type :rect :width 40 :height 30 :x 25 :y 35 :frame-id (:id popup-frame) :parent-id (:id popup-frame)})
overlay-frame (cts/setup-shape {:type :frame :width 30 :height 20})
objects {uuid/zero root-frame
(:id base-frame) base-frame
(:id popup-frame) popup-frame
(:id trigger) trigger
(:id overlay-frame) overlay-frame}
interaction (-> ctsi/default-interaction
(ctsi/set-action-type :open-overlay)
(ctsi/set-destination (:id overlay-frame))
(ctsi/set-position-relative-to (:id popup-frame)))
frame-offset (gpt/point 7 9)]
;; When the destination is missing we should return a harmless fallback instead of trying to measure a nil frame.
(t/testing "Missing destination frame falls back to origin"
(let [[overlay-pos snap] (ctsi/calc-overlay-position interaction trigger objects popup-frame base-frame nil frame-offset)]
(t/is (= (gpt/point 0 0) overlay-pos))
(t/is (= [:top :left] snap))))
;; Manual positions inside nested frames must include the parent frame offset to match the rendered viewport coordinates.
(t/testing "Nested frame manual positions add parent frame offset"
(let [manual-interaction (-> interaction
(ctsi/set-overlay-pos-type :manual trigger objects)
(ctsi/set-overlay-position (gpt/point 12 18)))
[overlay-pos snap] (ctsi/calc-overlay-position manual-interaction trigger objects popup-frame base-frame overlay-frame frame-offset)]
(t/is (= (gpt/point 59 57) overlay-pos))
(t/is (= [:top :left] snap))))
;; If the trigger itself is a frame, manual coordinates are already expressed in the correct local space and should not be adjusted.
(t/testing "Frame relative manual positions keep their local coordinates"
(let [frame-relative (-> interaction
(ctsi/set-position-relative-to (:id base-frame))
(ctsi/set-overlay-pos-type :manual base-frame objects)
(ctsi/set-overlay-position (gpt/point 11 13)))
[overlay-pos snap] (ctsi/calc-overlay-position frame-relative base-frame objects base-frame base-frame overlay-frame frame-offset)]
(t/is (= (gpt/point 18 22) overlay-pos))
(t/is (= [:top :left] snap))))))

2
frontend/src/app/main/data/viewer.cljs
View File

@@ -304,6 +304,7 @@
index (some-> (:index params) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
srect (-> (nth frames index)
(get :selrect))
osize (dm/get-in state [:viewer-local :viewport-size])
@@ -327,6 +328,7 @@
index (some-> (:index params) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
srect (-> (nth frames index)
(get :selrect))

12
frontend/src/app/main/data/workspace/drawing/curve.cljs
View File

@@ -11,7 +11,7 @@
[app.common.geom.shapes.flex-layout :as gslf]
[app.common.geom.shapes.grid-layout :as gslg]
[app.common.types.container :as ctn]
[app.common.types.path.segment :as path.segment]
[app.common.types.path :as path]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
@@ -33,7 +33,7 @@
(update [_ state]
(let [objects (dsh/lookup-page-objects state)
content (dm/get-in state [:workspace-drawing :object :content])
position (path.segment/get-handler-point content 0 nil)
position (path/get-handler-point content 0 nil)
frame-id (->> (ctst/top-nested-frame objects position)
(ctn/get-first-valid-parent objects) ;; We don't want to change the structure of component copies
@@ -65,8 +65,8 @@
(fn [object]
(let [points (-> (::points object)
(conj point))
content (path.segment/points->content points)
selrect (path.segment/content->selrect content)
content (path/points->content points)
selrect (path/calc-selrect content)
points' (grc/rect->points selrect)]
(-> object
(assoc ::points points)
@@ -82,8 +82,8 @@
(update-in state [:workspace-drawing :object]
(fn [{:keys [::points] :as shape}]
(let [points (ups/simplify points simplify-tolerance)
content (path.segment/points->content points)
selrect (path.segment/content->selrect content)
content (path/points->content points)
selrect (path/calc-selrect content)
points (grc/rect->points selrect)]
(-> shape

7
frontend/src/app/main/data/workspace/path/drawing.cljs
View File

@@ -13,7 +13,6 @@
[app.common.types.container :as ctn]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
@@ -64,7 +63,7 @@
{:keys [last-point prev-handler]}
(get-in state [:workspace-local :edit-path id])
segment (path.segment/next-node shape position last-point prev-handler)]
segment (path/next-node shape position last-point prev-handler)]
(assoc-in state [:workspace-local :edit-path id :preview] segment)))))
(defn add-node
@@ -99,7 +98,7 @@
prefix (or prefix :c1)
position (or position (path.helpers/segment->point (nth content (dec index))))
old-handler (path.segment/get-handler-point content index prefix)
old-handler (path/get-handler-point content index prefix)
handler-position (cond-> (gpt/point x y)
shift? (path.helpers/position-fixed-angle position))
@@ -148,7 +147,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [content (st/get-path state :content)
handlers (-> (path.segment/get-handlers content)
handlers (-> (path/get-handlers content)
(get position))
[idx prefix] (when (= (count handlers) 1)

13
frontend/src/app/main/data/workspace/path/edition.cljs
View File

@@ -11,7 +11,6 @@
[app.common.geom.point :as gpt]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.main.data.changes :as dch]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.edition :as dwe]
@@ -74,8 +73,8 @@
(defn modify-content-point
[content {dx :x dy :y} modifiers point]
(let [point-indices (path.segment/point-indices content point) ;; [indices]
handler-indices (path.segment/handler-indices content point) ;; [[index prefix]]
(let [point-indices (path/point-indices content point) ;; [indices]
handler-indices (path/handler-indices content point) ;; [[index prefix]]
modify-point
(fn [modifiers index]
@@ -258,10 +257,10 @@
points (path/get-points content)
point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.helpers/segment->point))
handler (-> content (nth index) (path.segment/get-handler prefix))
handler (-> content (nth index) (path/get-handler prefix))
[op-idx op-prefix] (path.segment/opposite-index content index prefix)
opposite (path.segment/get-handler-point content op-idx op-prefix)]
[op-idx op-prefix] (path/opposite-index content index prefix)
opposite (path/get-handler-point content op-idx op-prefix)]
(streams/drag-stream
(rx/concat
@@ -344,7 +343,7 @@
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] content)
(st/set-content (-> content
(path.segment/split-segments #{from-p to-p} t)
(path/split-segments #{from-p to-p} t)
(path/content))))))
ptk/WatchEvent

15
frontend/src/app/main/data/workspace/path/helpers.cljs
View File

@@ -9,15 +9,14 @@
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]))
[app.common.types.path.helpers :as path.helpers]))
(defn append-node
"Creates a new node in the path. Usually used when drawing."
[shape position prev-point prev-handler]
(let [segment (path.segment/next-node (:content shape) position prev-point prev-handler)]
(let [segment (path/next-node (:content shape) position prev-point prev-handler)]
(-> shape
(update :content path.segment/append-segment segment)
(update :content path/append-segment segment)
(path/update-geometry))))
(defn angle-points [common p1 p2]
@@ -61,11 +60,11 @@
[content index prefix match-distance? match-angle? dx dy]
(let [[cx cy] (path.helpers/prefix->coords prefix)
[op-idx op-prefix] (path.segment/opposite-index content index prefix)
[op-idx op-prefix] (path/opposite-index content index prefix)
node (path.segment/handler->node content index prefix)
handler (path.segment/get-handler-point content index prefix)
opposite (path.segment/get-handler-point content op-idx op-prefix)
node (path/handler->node content index prefix)
handler (path/get-handler-point content index prefix)
opposite (path/get-handler-point content op-idx op-prefix)
[ocx ocy] (path.helpers/prefix->coords op-prefix)
[odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)

15
frontend/src/app/main/data/workspace/path/tools.cljs
View File

@@ -8,7 +8,6 @@
(:require
[app.common.data.macros :as dm]
[app.common.types.path :as path]
[app.common.types.path.segment :as path.segment]
[app.main.data.changes :as dch]
[app.main.data.helpers :as dsh]
[app.main.data.workspace.edition :as dwe]
@@ -59,7 +58,7 @@
(process-path-tool
(when point #{point})
(fn [content points]
(reduce path.segment/make-corner-point content points)))))
(reduce path/make-corner-point content points)))))
(defn make-curve
([]
@@ -68,22 +67,22 @@
(process-path-tool
(when point #{point})
(fn [content points]
(reduce path.segment/make-curve-point content points)))))
(reduce path/make-curve-point content points)))))
(defn add-node []
(process-path-tool (fn [content points] (path.segment/split-segments content points 0.5))))
(process-path-tool (fn [content points] (path/split-segments content points 0.5))))
(defn remove-node []
(process-path-tool path.segment/remove-nodes))
(process-path-tool path/remove-nodes))
(defn merge-nodes []
(process-path-tool path.segment/merge-nodes))
(process-path-tool path/merge-nodes))
(defn join-nodes []
(process-path-tool path.segment/join-nodes))
(process-path-tool path/join-nodes))
(defn separate-nodes []
(process-path-tool path.segment/separate-nodes))
(process-path-tool path/separate-nodes))
(defn toggle-snap []
(ptk/reify ::toggle-snap

42
frontend/src/app/main/data/workspace/thumbnails.cljs
View File

@@ -217,31 +217,37 @@
root-frame-old? (cfh/root-frame? old-objects old-frame-id)
root-frame-new? (cfh/root-frame? new-objects new-frame-id)
instance-root? (ctc/instance-root? new-shape)]
instance-root? (ctc/instance-root? new-shape)
local-result (cond-> #{}
root-frame-old?
(conj ["frame" old-frame-id])
(cond-> #{}
root-frame-old?
(conj ["frame" old-frame-id])
root-frame-new?
(conj ["frame" new-frame-id])
root-frame-new?
(conj ["frame" new-frame-id])
instance-root?
(conj ["component" id]))]
instance-root?
(conj ["component" id])
(swap! frame-id-cache assoc id local-result)
(and (uuid? (:frame-id old-shape))
(not= uuid/zero (:frame-id old-shape)))
(into (get-frame-ids (:frame-id old-shape)))
(let [result
(cond-> local-result
(and (uuid? (:frame-id old-shape))
(not= uuid/zero (:frame-id old-shape))
(not= id (:frame-id old-shape)))
(into (get-frame-ids-cached (:frame-id old-shape)))
(and (uuid? (:frame-id new-shape))
(not= uuid/zero (:frame-id new-shape)))
(into (get-frame-ids (:frame-id new-shape))))))
(and (uuid? (:frame-id new-shape))
(not= uuid/zero (:frame-id new-shape))
(not= id (:frame-id new-shape)))
(into (get-frame-ids-cached (:frame-id new-shape))))]
(swap! frame-id-cache assoc id result)
result)))
(get-frame-ids-cached [id]
(or (get @frame-id-cache id)
(let [result (get-frame-ids id)]
(swap! frame-id-cache assoc id result)
result)))]
(if (contains? @frame-id-cache id)
(get @frame-id-cache id)
(get-frame-ids id)))]
(into #{}
(comp (mapcat extract-ids)
(filter (fn [[page-id']] (= page-id page-id')))

36
frontend/src/app/main/errors.cljs
View File

@@ -53,16 +53,33 @@
(defn stale-asset-error?
"Returns true if the error matches the signature of a cross-build
module mismatch: accessing a ClojureScript keyword constant that
doesn't exist on the shared $APP object."
module mismatch. Two distinct patterns can appear depending on which
cross-module reference is accessed first:
1. Keyword constants – names contain '$cljs$cst$'; these arise when a
compiled keyword defined in shared.js is absent in the version of
shared.js already resident in the browser.
2. Protocol dispatch – names contain '$cljs$core$I'; these arise when
main-workspace.js (new build) tries to invoke a protocol method on
an object whose prototype was stamped by an older shared.js that
used different mangled property names (e.g. the LazySeq /
instaparse crash: 'Cannot read properties of undefined (reading
\\'$cljs$core$IFn$_invoke$arity$1$\\')').
Both patterns are symptoms of the same split-brain deployment
scenario (browser has JS chunks from two different builds) and
should trigger a hard page reload."
[cause]
(when (some? cause)
(let [message (ex-message cause)]
(and (string? message)
(str/includes? message "$cljs$cst$")
(or (str/includes? message "$cljs$cst$")
(str/includes? message "$cljs$core$I"))
(or (str/includes? message "is undefined")
(str/includes? message "is null")
(str/includes? message "is not a function"))))))
(str/includes? message "is not a function")
(str/includes? message "Cannot read properties of undefined"))))))
(defn exception->error-data
[cause]
@@ -419,7 +436,16 @@
;; RxJS unsubscription / take-until chain). These are
;; handled gracefully inside app.util.http/fetch and must NOT
;; be surfaced as application errors.
(= (.-name ^js cause) "AbortError"))))
(= (.-name ^js cause) "AbortError")
;; Zone.js (injected by browser extensions such as Angular
;; DevTools) wraps event listeners and assigns a custom
;; .toString to its wrapper functions using
;; Object.defineProperty. When the wrapper was previously
;; defined with {writable: false}, a subsequent plain assignment
;; in strict mode (our libs.js uses "use strict") throws this
;; TypeError. This is a known Zone.js / browser-extension
;; incompatibility and is NOT a Penpot bug.
(str/starts-with? message "Cannot assign to read only property 'toString'"))))
(on-unhandled-error [event]
(.preventDefault ^js event)

5
frontend/src/app/main/ui/workspace/shapes/debug.cljs
View File

@@ -15,7 +15,6 @@
[app.common.types.path :as path]
[app.common.types.path.bool :as path.bool]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.common.types.path.subpath :as path.subpath]
[app.main.refs :as refs]
[app.util.color :as uc]
@@ -124,8 +123,8 @@
(path.bool/add-previous))
sr-a (path.segment/content->selrect content-a)
sr-b (path.segment/content->selrect content-b)
sr-a (path/calc-selrect content-a)
sr-b (path/calc-selrect content-b)
[content-a-split content-b-split] (path.bool/content-intersect-split content-a content-b sr-a sr-b)

13
frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
View File

@@ -11,7 +11,6 @@
[app.common.geom.point :as gpt]
[app.common.types.path :as path]
[app.common.types.path.helpers :as path.helpers]
[app.common.types.path.segment :as path.segment]
[app.main.data.workspace.path :as drp]
[app.main.snap :as snap]
[app.main.store :as st]
@@ -251,8 +250,8 @@
(defn- matching-handler? [content node handlers]
(when (= 2 (count handlers))
(let [[[i1 p1] [i2 p2]] handlers
p1 (path.segment/get-handler-point content i1 p1)
p2 (path.segment/get-handler-point content i2 p2)
p1 (path/get-handler-point content i1 p1)
p2 (path/get-handler-point content i2 p2)
v1 (gpt/to-vec node p1)
v2 (gpt/to-vec node p2)
@@ -309,7 +308,7 @@
handlers
(mf/with-memo [content]
(path.segment/get-handlers content))
(path/get-handlers content))
is-path-start
(not (some? last-point))
@@ -331,7 +330,7 @@
ms/mouse-position
(mf/deps base-content zoom)
(fn [position]
(when-let [point (path.segment/closest-point base-content position (/ 0.01 zoom))]
(when-let [point (path/closest-point base-content position (/ 0.01 zoom))]
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
[:g.path-editor {:ref editor-ref}
@@ -367,7 +366,7 @@
(fn [[index prefix]]
;; FIXME: get-handler-point is executed twice for each
;; render, this can be optimized
(let [handler-position (path.segment/get-handler-point content index prefix)]
(let [handler-position (path/get-handler-point content index prefix)]
(not= position handler-position)))
position-handlers
@@ -390,7 +389,7 @@
[:g.path-node {:key (dm/str pos-x "-" pos-y)}
[:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
(for [[hindex prefix] position-handlers]
(let [handler-position (path.segment/get-handler-point content hindex prefix)
(let [handler-position (path/get-handler-point content hindex prefix)
handler-hover? (contains? hover-handlers [hindex prefix])
moving-handler? (= handler-position moving-handler)
matching-handler? (matching-handler? content position position-handlers)]

69
frontend/test/frontend_tests/data/viewer_test.cljs Normal file
View File

@@ -0,0 +1,69 @@
;; 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 frontend-tests.data.viewer-test
(:require
[app.common.uuid :as uuid]
[app.main.data.viewer :as dv]
[cljs.test :as t]
[potok.v2.core :as ptk]))
(def ^:private page-id
(uuid/custom 1 1))
(defn- base-state
"Build a minimal viewer state with the given frames and query-params."
[{:keys [frames index]}]
{:route {:params {:query {:page-id (str page-id)
:index (str index)}}}
:viewer {:pages {page-id {:frames frames}}}
:viewer-local {:viewport-size {:width 1000 :height 800}}})
(t/deftest zoom-to-fit-clamps-out-of-bounds-index
(t/testing "index exceeds frame count"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}]
:index 1})
result (ptk/update dv/zoom-to-fit state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fit))
(t/is (number? (get-in result [:viewer-local :zoom])))))
(t/testing "index is zero with single frame (normal case)"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}]
:index 0})
result (ptk/update dv/zoom-to-fit state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fit))
(t/is (number? (get-in result [:viewer-local :zoom])))))
(t/testing "index within valid range with multiple frames"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}
{:selrect {:width 200 :height 200}}]
:index 1})
result (ptk/update dv/zoom-to-fit state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fit))
(t/is (number? (get-in result [:viewer-local :zoom]))))))
(t/deftest zoom-to-fill-clamps-out-of-bounds-index
(t/testing "index exceeds frame count"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}]
:index 1})
result (ptk/update dv/zoom-to-fill state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fill))
(t/is (number? (get-in result [:viewer-local :zoom])))))
(t/testing "index is zero with single frame (normal case)"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}]
:index 0})
result (ptk/update dv/zoom-to-fill state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fill))
(t/is (number? (get-in result [:viewer-local :zoom])))))
(t/testing "index within valid range with multiple frames"
(let [state (base-state {:frames [{:selrect {:width 100 :height 100}}
{:selrect {:width 200 :height 200}}]
:index 1})
result (ptk/update dv/zoom-to-fill state)]
(t/is (= (get-in result [:viewer-local :zoom-type]) :fill))
(t/is (number? (get-in result [:viewer-local :zoom]))))))

36
frontend/test/frontend_tests/data/workspace_thumbnails_test.cljs Normal file
View File

@@ -0,0 +1,36 @@
;; 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 frontend-tests.data.workspace-thumbnails-test
(:require
[app.common.uuid :as uuid]
[app.main.data.workspace.thumbnails :as thumbnails]
[cljs.test :as t :include-macros true]))
(t/deftest extract-frame-changes-handles-cyclic-frame-links
(let [page-id (uuid/next)
root-id (uuid/next)
shape-a-id (uuid/next)
shape-b-id (uuid/next)
event {:changes [{:type :mod-obj
:page-id page-id
:id shape-a-id}]}
old-data {:pages-index
{page-id
{:objects
{root-id {:id root-id :type :frame :frame-id uuid/zero}
shape-a-id {:id shape-a-id :type :rect :frame-id shape-b-id}
shape-b-id {:id shape-b-id :type :group :frame-id shape-a-id}}}}}
new-data {:pages-index
{page-id
{:objects
{root-id {:id root-id :type :frame :frame-id uuid/zero}
shape-a-id {:id shape-a-id :type :rect :frame-id root-id}
shape-b-id {:id shape-b-id :type :group :frame-id shape-a-id
:component-root true}}}}}]
(t/is (= #{["frame" root-id]
["component" shape-b-id]}
(#'thumbnails/extract-frame-changes page-id [event [old-data new-data]])))))

6
frontend/test/frontend_tests/runner.cljs
View File

@@ -3,8 +3,10 @@
[cljs.test :as t]
[frontend-tests.basic-shapes-test]
[frontend-tests.data.repo-test]
[frontend-tests.data.viewer-test]
[frontend-tests.data.workspace-colors-test]
[frontend-tests.data.workspace-texts-test]
[frontend-tests.data.workspace-thumbnails-test]
[frontend-tests.helpers-shapes-test]
[frontend-tests.logic.comp-remove-swap-slots-test]
[frontend-tests.logic.components-and-tokens]
@@ -39,8 +41,10 @@
(t/run-tests
'frontend-tests.basic-shapes-test
'frontend-tests.data.repo-test
'frontend-tests.data.viewer-test
'frontend-tests.data.workspace-colors-test
'frontend-tests.data.workspace-texts-test
'frontend-tests.data.workspace-thumbnails-test
'frontend-tests.helpers-shapes-test
'frontend-tests.logic.comp-remove-swap-slots-test
'frontend-tests.logic.components-and-tokens
@@ -56,9 +60,9 @@
'frontend-tests.tokens.logic.token-remapping-test
'frontend-tests.tokens.style-dictionary-test
'frontend-tests.tokens.token-errors-test
'frontend-tests.tokens.workspace-tokens-remap-test
'frontend-tests.ui.ds-controls-numeric-input-test
'frontend-tests.util-object-test
'frontend-tests.util-range-tree-test
'frontend-tests.util-simple-math-test
'frontend-tests.tokens.workspace-tokens-remap-test
'frontend-tests.worker-snap-test))

2
package.json
View File

@@ -19,6 +19,6 @@
"@github/copilot": "^1.0.12",
"@types/node": "^20.12.7",
"esbuild": "^0.27.4",
"opencode-ai": "^1.3.7"
"opencode-ai": "^1.3.17"
}
}

106
pnpm-lock.yaml generated
View File

@@ -18,8 +18,8 @@ importers:
specifier: ^0.27.4
version: 0.27.4
opencode-ai:
specifier: ^1.3.7
version: 1.3.7
specifier: ^1.3.17
version: 1.3.17
packages:
@@ -227,67 +227,67 @@ packages:
engines: {node: '>=18'}
hasBin: true
opencode-ai@1.3.7:
resolution: {integrity: sha512-AtqTOcPvHkAF/zPGs/08/8m2DeiWADCGhT/WAJ1drGem4WdPOt45jkJLPdOCheN1gqmLxTcNV0veKFVHmbjKKQ==}
opencode-ai@1.3.17:
resolution: {integrity: sha512-2Awq2za4kLPG9wxFHFmqcmoveTSTeyq7Q3GJ8PoQahjWU17yCjuyJUclouFULzaZgqA8atHOyT/3eUHigMc8Cw==}
hasBin: true
opencode-darwin-arm64@1.3.7:
resolution: {integrity: sha512-TRglBnrSzeR9pEFV8Z1ACqhD3r3WYl8v1y9TkgvHviTD/EXGL3Nu7f/fy3XOQprPGSLPyrlOwZXb1i9XrfTo1A==}
opencode-darwin-arm64@1.3.17:
resolution: {integrity: sha512-aaMXeNQRPLdGPoxULFty1kxYxT2qPXCiqftYbLF2SQN9Xjq8BR3BjA766ncae1hdiDJJAe1CSpWDbobn5K+oyA==}
cpu: [arm64]
os: [darwin]
opencode-darwin-x64-baseline@1.3.7:
resolution: {integrity: sha512-YLl+peZIC1m295JNSMzM/NM5uNs2GVewZply2GV3P6WApS5JuRIaMNvzOk7jpL90yt6pur6oEwC8g0WWwP8G4A==}
opencode-darwin-x64-baseline@1.3.17:
resolution: {integrity: sha512-ftEiCwzl6OjIqpXD075lHWHT1YKJjNDPvL1XlLDv86Wt4Noc818fl1lOWwg/LkNL04LoXD2oa3NGOJZYzd6STQ==}
cpu: [x64]
os: [darwin]
opencode-darwin-x64@1.3.7:
resolution: {integrity: sha512-Nsyh3vLAqqfVyWD4qrcyRJit+CmZZpm6IdXTk9wo1hUAE/RmYIBDz1To99ZBwA3SJB1fLrciYicMN2uq8r1XNw==}
opencode-darwin-x64@1.3.17:
resolution: {integrity: sha512-fMlnOCtaMnwimdP81a3F7QK9GUwhrQnxaKuUZk31wYcGBGQKgSSdy2xK8CRLcaHEV8gLxSlcGJj7g4NTOrC9Tw==}
cpu: [x64]
os: [darwin]
opencode-linux-arm64-musl@1.3.7:
resolution: {integrity: sha512-D4gCn7oVLCc3xN0BSJOfYerCr1E1ktUkixfHQEmkoR1CLZ77Z/aHSgcm0Ln01Q+ie6MsVukvuyUQn9GEY1Dn/A==}
opencode-linux-arm64-musl@1.3.17:
resolution: {integrity: sha512-clD6K35+pP60xLiqCJFTTTpDK2XFahOlSo8TQckXCvCnYYwMqdK9sOO7uzDHLNyPIGLKiYNZTxqVazuGnbGmYQ==}
cpu: [arm64]
os: [linux]
opencode-linux-arm64@1.3.7:
resolution: {integrity: sha512-72OnT20wIhkXMGclmw7S+d8JjIb9lx8pPIW8pkyI79+qxLTp6AuTHsmUG/qDhw3NMtVDs9efAb0C/FjLXATeAA==}
opencode-linux-arm64@1.3.17:
resolution: {integrity: sha512-gd4kndxNwYi9kINyrTItY35M7UZ4jAXMxbbdbFnUBFYI009uv4bgNofnZnVOAFfjc0/PpxSgdNn9eHDjlJEdJQ==}
cpu: [arm64]
os: [linux]
opencode-linux-x64-baseline-musl@1.3.7:
resolution: {integrity: sha512-DE8eqPF2benmdzUdMG+rnr0J3DtrP+x8sUzq7gecuNnU4iHo4s8Itx+gCLP978ZBdYwTkNRtNZ5BKN0ePT5KYQ==}
opencode-linux-x64-baseline-musl@1.3.17:
resolution: {integrity: sha512-BiNu5B6QfohG+KwNcY3YlKR465DNke0nknRqn3Ke2APp6GghuimlnyEKcji1brhZsdjdembc79KWfQcsHlYsyA==}
cpu: [x64]
os: [linux]
opencode-linux-x64-baseline@1.3.7:
resolution: {integrity: sha512-Aztdiq0U6H8Nww7mmARK/ZGkllTrePuyEEdzg2+0LWfUpDO5Cl/pMJ8btqVtTjfb/pLw+BU3JtYxw8oOhRkl/A==}
opencode-linux-x64-baseline@1.3.17:
resolution: {integrity: sha512-OIp+jdr9Rus6kAVWgB8cuGMRPFVJdMwQvjOfprbgoM2KUIjgXKsXgyCmetKZIH/iadmVffjv7p6QrYWFDh6cBA==}
cpu: [x64]
os: [linux]
opencode-linux-x64-musl@1.3.7:
resolution: {integrity: sha512-L0ohQAbw1Ib1koawV/yJAYIGIel2zMPafbdeMXELIvpes3Sq9qIfCSRB/2ROu8gjN8P1TGnUU6Vx1F3MtJOvIA==}
opencode-linux-x64-musl@1.3.17:
resolution: {integrity: sha512-/GfRB+vuadE6KAM0kxPQHno3ywxBfiRJp5uZLLKSGAEunXo9az1wkmSR97g4tnxHD4F59hjYOloK9XQQIDwgog==}
cpu: [x64]
os: [linux]
opencode-linux-x64@1.3.7:
resolution: {integrity: sha512-rCFXrgDLhPuHazomDgzBXGLE0wJ4VRHrIe26WCHm4iqmGu9O6ExZd612Y07/CGQm4bVBHlaalcWh7N/z6GOPkA==}
opencode-linux-x64@1.3.17:
resolution: {integrity: sha512-FmoKpX+g78qi4MPvRMWZMZZYKVuH7qkNFXEqGUb0wtixvwuWYvqmUeF9D0GLM/rZnGA33sW6nCkro8aCuyR0Bw==}
cpu: [x64]
os: [linux]
opencode-windows-arm64@1.3.7:
resolution: {integrity: sha512-s6emZ28ORIMtKyrBKvo96q2qanRwbjPHK/rOMinZ22SW7DLzNKKf1p92JMkSni0dXXGL64jsy1se5IvELc7Mvg==}
opencode-windows-arm64@1.3.17:
resolution: {integrity: sha512-gXZ+JKwCUZ9yjVilvnn6zg5vvRy0oPgqIO6qyfvXiLXV+UWJaSTlXl6/4CeXOkvvYeXhLdCtIFii2jbQJjHR3g==}
cpu: [arm64]
os: [win32]
opencode-windows-x64-baseline@1.3.7:
resolution: {integrity: sha512-CGbhvn9rMXV4xEjw1lxPFbsWuOPf/xJ1AAblqKsF2VmSbqe25QG5VIf88hsJo8YmYIHz6U7tNGI4lTF1zVx9cw==}
opencode-windows-x64-baseline@1.3.17:
resolution: {integrity: sha512-Q61MuJBTt+qLyClTEaqbCHh3Fivx0eZ1vHKlhEk7MfIdP/LoDbvSitNRUgtsU/C+ct5Y+c6JXOlxlaFFpqybeA==}
cpu: [x64]
os: [win32]
opencode-windows-x64@1.3.7:
resolution: {integrity: sha512-q7V9p10Q7BH03tnYMG4k6B1ZXLDriDMtXkkw+NW1p22F7dQ22WmaMoCWnv3d4b2vNyjMjIYuPm97q0v02QI08w==}
opencode-windows-x64@1.3.17:
resolution: {integrity: sha512-+arPhczUa5NBH/thsKAxLmXgkB2WAxtj8Dd293GJZBBEXRhWF1jsXbLvGLY3qDBbvXm9XR7CkJqL1at344pQLw==}
cpu: [x64]
os: [win32]
@@ -434,55 +434,55 @@ snapshots:
'@esbuild/win32-ia32': 0.27.4
'@esbuild/win32-x64': 0.27.4
opencode-ai@1.3.7:
opencode-ai@1.3.17:
optionalDependencies:
opencode-darwin-arm64: 1.3.7
opencode-darwin-x64: 1.3.7
opencode-darwin-x64-baseline: 1.3.7
opencode-linux-arm64: 1.3.7
opencode-linux-arm64-musl: 1.3.7
opencode-linux-x64: 1.3.7
opencode-linux-x64-baseline: 1.3.7
opencode-linux-x64-baseline-musl: 1.3.7
opencode-linux-x64-musl: 1.3.7
opencode-windows-arm64: 1.3.7
opencode-windows-x64: 1.3.7
opencode-windows-x64-baseline: 1.3.7
opencode-darwin-arm64: 1.3.17
opencode-darwin-x64: 1.3.17
opencode-darwin-x64-baseline: 1.3.17
opencode-linux-arm64: 1.3.17
opencode-linux-arm64-musl: 1.3.17
opencode-linux-x64: 1.3.17
opencode-linux-x64-baseline: 1.3.17
opencode-linux-x64-baseline-musl: 1.3.17
opencode-linux-x64-musl: 1.3.17
opencode-windows-arm64: 1.3.17
opencode-windows-x64: 1.3.17
opencode-windows-x64-baseline: 1.3.17
opencode-darwin-arm64@1.3.7:
opencode-darwin-arm64@1.3.17:
optional: true
opencode-darwin-x64-baseline@1.3.7:
opencode-darwin-x64-baseline@1.3.17:
optional: true
opencode-darwin-x64@1.3.7:
opencode-darwin-x64@1.3.17:
optional: true
opencode-linux-arm64-musl@1.3.7:
opencode-linux-arm64-musl@1.3.17:
optional: true
opencode-linux-arm64@1.3.7:
opencode-linux-arm64@1.3.17:
optional: true
opencode-linux-x64-baseline-musl@1.3.7:
opencode-linux-x64-baseline-musl@1.3.17:
optional: true
opencode-linux-x64-baseline@1.3.7:
opencode-linux-x64-baseline@1.3.17:
optional: true
opencode-linux-x64-musl@1.3.7:
opencode-linux-x64-musl@1.3.17:
optional: true
opencode-linux-x64@1.3.7:
opencode-linux-x64@1.3.17:
optional: true
opencode-windows-arm64@1.3.7:
opencode-windows-arm64@1.3.17:
optional: true
opencode-windows-x64-baseline@1.3.7:
opencode-windows-x64-baseline@1.3.17:
optional: true
opencode-windows-x64@1.3.7:
opencode-windows-x64@1.3.17:
optional: true
undici-types@6.21.0: {}