github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-04-25 19:28:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

🐛 Fix crash in apply-text-modifier with nil selrect or modifier (#8762)

Browse Source 
* 🐛 Fix crash in apply-text-modifier with nil selrect or modifier

Guard apply-text-modifier against nil text-modifier and nil selrect
to prevent the 'invalid arguments (on pointer constructor)' error
thrown by gpt/point when called with an invalid map.

- In text-wrapper: only call apply-text-modifier when text-modifier is
  not nil (avoids unnecessary processing)
- In apply-text-modifier: handle nil text-modifier by returning shape
  unchanged; guard selrect access before calling gpt/point

* 📚 Add tests for apply-text-modifier in workspace texts

Add exhaustive unit tests covering all paths of apply-text-modifier:
- nil modifier returns shape unchanged (identity)
- modifier with no recognised keys leaves shape unchanged
- :width / :height modifiers resize shape correctly
- nil :width / :height keys are skipped
- both dimensions applied simultaneously
- :position-data is set and nil-guarded
- position-data coordinates translated by delta on resize
- shape with nil selrect + nil modifier does not throw
- position-data-only modifier on shape without selrect is safe
- selrect origin preserved when no dimension changes
- result always carries required shape keys

* 🐛 Fix zero-dimension selrect crash in change-dimensions-modifiers

When a text shape is decoded from the server via map->Rect (which
bypasses make-rect's 0.01 minimum enforcement), its selrect can have
width or height of exactly 0.  change-dimensions-modifiers and
change-size were dividing by these values, producing Infinity scale
factors that propagated through the transform pipeline until
calculate-selrect / center->rect returned nil, causing gpt/point to
throw 'invalid arguments (on pointer constructor)'.

Fix: before computing scale factors, guard sr-width / sr-height (and
old-width / old-height in change-size) against zero/negative and
non-finite values.  When degenerate, fall back to the shape's own
top-level :width/:height so the denominator and proportion-lock base
remain consistent.

Also simplify apply-text-modifier's delta calculation now that the
transform pipeline is guaranteed to produce a valid selrect, and
update the test suite to test the exact degenerate-selrect scenario
that triggered the original crash.

Signed-off-by: Andrey Antukh <niwi@niwi.nz>

* ♻️ Simplify change-dimensions-modifiers internal logic

- Remove the intermediate 'size' map ({:width sr-width :height sr-height})
  that was built only to be assoc'd and immediately destructured back into
  width/height; compute both values directly instead.

- Replace the double-negated condition 'if-not (and (not ignore-lock?) …)'
  with a clear positive 'locked?' binding, and flatten the three-branch
  if-not/if tree into two independent if expressions keyed on 'attr'.

- Call safe-size-rect once and reuse its result for both the fallback
  sizes and the scale computation, eliminating a redundant call.

- Access :transform and :transform-inverse via direct map lookup rather
  than destructuring in the function signature, consistent with how the
  rest of the let-block reads shape keys.

- Clean up change-size to use the same destructuring style as the updated
  function ({sr-width :width sr-height :height}).

- Fix typo in comment: 'havig' -> 'having'.

* ✨ Add tests for change-size and change-dimensions-modifiers

Cover the main behavioural contract of both functions:

change-size:
- Scales both axes to the requested target dimensions.
- Sets the resize origin to the shape's top-left point.
- Nil width/height each fall back to the current dimension (scale 1 on
  that axis); both nil produces an identity resize that is optimised away.
- Propagates the shape's transform and transform-inverse matrices into the
  resulting GeometricOperation.

change-dimensions-modifiers:
- Changing :width without proportion-lock only scales the x-axis (y
  scale stays 1), and vice-versa for :height.
- With proportion-lock enabled, changing :width adjusts height via the
  inverse proportion, and changing :height adjusts width via the
  proportion.
- ignore-lock? true bypasses proportion-lock regardless of shape state.
- Values below 0.01 are clamped to 0.01 before computing the scale.
- End-to-end: applying the returned modifiers via gsh/transform-shape
  yields the expected selrect dimensions.

* ✨ Harden safe-size-rect with additional fallbacks

The previous implementation could still return an invalid rect in several
edge cases.  The new version tries four sources in order, accepting each
only if it passes a dedicated safe-size-rect? predicate:

1. :selrect           – used when width and height are finite, positive
                        and within [-max-safe-int, max-safe-int].
2. points->rect       – computed from the shape corner points; subject to
                        the same predicate.
3. Top-level shape fields (:x :y :width :height) – present on all rect,
                        frame, image, and component shape types.
4. grc/empty-rect     – a 0,0 0.01×0.01 unit rect used as last resort so
                        callers always receive a usable, non-crashing value.

The out-of-range check (> max-safe-int) is new: it rejects coordinates
that pass d/num? (finite) but exceed the platform integer boundary defined
in app.common.schema, which previously slipped through undetected.

Tests cover all four fallback paths, including the NaN, zero-dimension,
and max-safe-int overflow cases.

* ⚡ Optimise safe-size-rect for ClojureScript performance

- Replace (when (some? rect) ...) with (and ^boolean (some? rect) ...)
  to keep the entire predicate as a single boolean expression without
  introducing an implicit conditional branch.

- Replace keyword access (:width rect) / (:height rect) with
  dm/get-prop calls, consistent with the hot-path style used throughout
  the rest of the namespace.

- Add ^boolean type hints to every sub-expression of the and chain in
  safe-size-rect? (d/num?, pos?, <=) so the ClojureScript compiler emits
  raw JS boolean operations instead of boxing the results through
  cljs.core/truth_.

- Replace (when (safe-size-rect? ...) value) in safe-size-rect with
  (and ^boolean (safe-size-rect? ...) value), avoiding an extra
  conditional and keeping the or fallback chain free of allocated
  intermediate objects.

* ✨ Use safe-size-rect in apply-text-modifier delta-move computation

safe-size-rect was already used inside change-dimensions-modifiers to
guard the resize scale computation. However, apply-text-modifier in
texts.cljs was still reading (:selrect shape) and (:selrect new-shape)
directly to build the delta-move vector via gpt/point.

gpt/point raises "invalid arguments (on pointer constructor)" when
given a nil value or a map with non-finite :x/:y, which can happen when
a shape's selrect is missing or degenerate (e.g. decoded from the server
via map->Rect, bypassing make-rect's 0.01 floor).

Changes:
- Promote safe-size-rect from defn- to defn in app.common.types.modifiers
  so it can be reused by consumers outside the namespace.
- Replace the two raw (:selrect …) accesses in the delta-move computation
  with (ctm/safe-size-rect …), which always returns a valid, finite rect
  through the established four-step fallback chain.
- Add two frontend tests covering the delta-move path with a fully
  degenerate (zero-dimension) selrect, ensuring neither a bare
  position-data modifier nor a combined width+position-data modifier
  throws.

* ♻️ Ensure all test shapes are proper Shape records in modifiers-test

All shapes in safe-size-rect-fallbacks tests now start from a proper
Shape record built by cts/setup-shape (via make-shape) instead of plain
hash-maps. Each test that mutates geometry fields (selrect, points,
width, height) does so via assoc on the already-initialised record,
which preserves the correct type while isolating the field under test.

A (cts/shape? shape) assertion is added to each fallback test to make
the type guarantee explicit and guard against regressions.

The unused shape-with-selrect helper (which built a bare map) is
removed.

* 🔥 Remove dead code and tighten visibility in app.common.types.modifiers

Dead functions removed (zero callers across the entire codebase):
- modifiers->transform-old: superseded by modifiers->transform; only
  ever appeared in a commented-out dev/bench.cljs entry.
- change-recursive-property: no callers anywhere.
- move-parent-modifiers, resize-parent-modifiers: convenience wrappers
  for the parent-geometry builder functions; never called.
- remove-children-modifiers, add-children-modifiers,
  scale-content-modifiers: single-op convenience builders; never called.
- select-structure: projection helper; only referenced by
  select-child-geometry-modifiers which is itself dead.
- select-child-geometry-modifiers: no callers anywhere.

Functions narrowed from defn to defn- (used only within this namespace):
- valid-vector?: assertion helper called only by move/resize builders.
- increase-order: called only by add-modifiers.
- transform-move!, transform-resize!, transform-rotate!, transform!:
  steps of the modifiers->transform pipeline.
- modifiers->transform1: immediate helper for modifiers->transform; the
  doc-string describing it as 'multiplatform' was also removed since it
  is an implementation detail.
- transform-text-node, transform-paragraph-node: leaf helpers for
  scale-text-content.
- update-text-content, scale-text-content, apply-scale-content: internal
  scale-content pipeline; all called only by apply-modifier.
- remove-children-set: called only by apply-modifier.
- select-structure: demoted to defn- rather than deleted because it is
  still called by select-child-structre-modifiers, which has external
  callers.

* ✨ Add more tests for modifiers

---------

Signed-off-by: Andrey Antukh <niwi@niwi.nz>
This commit is contained in:
Andrey Antukh 2026-03-30 11:04:54 +02:00 committed by GitHub
parent a149f31d56
commit b6524881e0
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
6 changed files with 994 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

198
common/src/app/common/types/modifiers.cljc
View File

@ -12,11 +12,13 @@
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.corners :as gsc]
[app.common.geom.shapes.effects :as gse]
[app.common.geom.shapes.strokes :as gss]
[app.common.math :as mth]
[app.common.schema :as sm]
[app.common.types.shape.layout :as ctl]
[app.common.types.text :as txt]
[clojure.core :as c]))
@ -117,6 +119,33 @@
(or (not ^boolean (mth/almost-zero? (- (dm/get-prop vector :x) 1)))
(not ^boolean (mth/almost-zero? (- (dm/get-prop vector :y) 1)))))
(defn- safe-size-rect?
"Returns true when `rect` has finite, in-range, positive width and height."
[rect]
(and ^boolean (some? rect)
(let [w (dm/get-prop rect :width)
h (dm/get-prop rect :height)]
(and ^boolean (d/num? w h)
^boolean (pos? w)
^boolean (pos? h)
^boolean (<= w sm/max-safe-int)
^boolean (<= h sm/max-safe-int)))))
(defn safe-size-rect
"Returns the best available size rect for a shape, trying several
fallbacks in order:
1. `:selrect` — if it has valid, in-range, positive dimensions.
2. `points->rect` — computed from the shape's corner points.
3. Top-level `:x :y :width :height` shape fields.
4. `grc/empty-rect` — a unit rect (0,0,0.01,0.01) of last resort."
[{:keys [selrect points x y width height]}]
(or (and ^boolean (safe-size-rect? selrect) selrect)
(let [from-points (grc/points->rect points)]
(and ^boolean (safe-size-rect? from-points) from-points))
(let [from-shape (grc/make-rect x y width height)]
(and ^boolean (safe-size-rect? from-shape) from-shape))
grc/empty-rect))
(defn- mergeable-move?
[op1 op2]
(let [type-op1 (dm/get-prop op1 :type)
@ -195,7 +224,7 @@
(conj item)))
(conj operations op))))))
(defn valid-vector?
(defn- valid-vector?
[vector]
(let [x (dm/get-prop vector :x)
y (dm/get-prop vector :y)]
@ -309,11 +338,6 @@
(-> (or modifiers (empty))
(update :structure-child conj (scale-content-op value))))
(defn change-recursive-property
[modifiers property value]
(-> (or modifiers (empty))
(update :structure-child conj (change-property-op property value))))
(defn change-property
[modifiers property value]
(-> (or modifiers (empty))
@ -348,7 +372,7 @@
(recur result (rest operations)))))))
(defn increase-order
(defn- increase-order
[operations last-order]
(->> operations
(mapv #(update % :order + last-order))))
@ -390,13 +414,6 @@
([vector]
(move (empty) vector)))
(defn move-parent-modifiers
([x y]
(move-parent (empty) (gpt/point x y)))
([vector]
(move-parent (empty) vector)))
(defn resize-modifiers
([vector origin]
(resize (empty) vector origin))
@ -404,13 +421,6 @@
([vector origin transform transform-inverse]
(resize (empty) vector origin transform transform-inverse)))
(defn resize-parent-modifiers
([vector origin]
(resize-parent (empty) vector origin))
([vector origin transform transform-inverse]
(resize-parent (empty) vector origin transform transform-inverse)))
(defn rotation-modifiers
[shape center angle]
(let [shape-center (gco/shape->center shape)
@ -426,73 +436,54 @@
(rotation shape-center angle)
(move move-vec))))
(defn remove-children-modifiers
[shapes]
(-> (empty)
(remove-children shapes)))
(defn add-children-modifiers
[shapes index]
(-> (empty)
(add-children shapes index)))
(defn reflow-modifiers
[]
(-> (empty)
(reflow)))
(defn scale-content-modifiers
[value]
(-> (empty)
(scale-content value)))
(defn change-size
[{:keys [selrect points transform transform-inverse] :as shape} width height]
(let [old-width (-> selrect :width)
old-height (-> selrect :height)
width (or width old-width)
height (or height old-height)
origin (first points)
scalex (/ width old-width)
scaley (/ height old-height)]
[{:keys [points transform transform-inverse] :as shape} width height]
(let [{sr-width :width sr-height :height} (safe-size-rect shape)
width (or width sr-width)
height (or height sr-height)
origin (first points)
scalex (/ width sr-width)
scaley (/ height sr-height)]
(resize-modifiers (gpt/point scalex scaley) origin transform transform-inverse)))
(defn change-dimensions-modifiers
([shape attr value]
(change-dimensions-modifiers shape attr value nil))
([{:keys [transform transform-inverse] :as shape} attr value {:keys [ignore-lock?] :or {ignore-lock? false}}]
([shape attr value {:keys [ignore-lock?] :or {ignore-lock? false}}]
(dm/assert! (map? shape))
(dm/assert! (#{:width :height} attr))
(dm/assert! (number? value))
(let [;; Avoid havig shapes with zero size
value (if (< (mth/abs value) 0.01)
0.01
value)
(let [;; Avoid having shapes with zero size
value (if (< (mth/abs value) 0.01) 0.01 value)
{:keys [proportion proportion-lock]} shape
size (select-keys (:selrect shape) [:width :height])
new-size (if-not (and (not ignore-lock?) proportion-lock)
(assoc size attr value)
(if (= attr :width)
(-> size
(assoc :width value)
(assoc :height (/ value proportion)))
(-> size
(assoc :height value)
(assoc :width (* value proportion)))))
{sr-width :width sr-height :height} (safe-size-rect shape)
locked? (and (not ignore-lock?) proportion-lock)
width (:width new-size)
height (:height new-size)
width (if (= attr :width)
value
(if locked? (* value proportion) sr-width))
{sr-width :width sr-height :height} (:selrect shape)
height (if (= attr :height)
value
(if locked? (/ value proportion) sr-height))
origin (-> shape :points first)
scalex (/ width sr-width)
scaley (/ height sr-height)]
(resize-modifiers (gpt/point scalex scaley) origin transform transform-inverse))))
(resize-modifiers
(gpt/point scalex scaley)
origin
(:transform shape)
(:transform-inverse shape)))))
(defn change-orientation-modifiers
[shape orientation]
@ -566,7 +557,7 @@
[modifiers]
(assoc (or modifiers (empty)) :geometry-child [] :structure-child []))
(defn select-structure
(defn- select-structure
[modifiers]
(assoc (or modifiers (empty)) :geometry-child [] :geometry-parent []))
@ -574,10 +565,6 @@
[modifiers]
(assoc (or modifiers (empty)) :structure-child [] :structure-parent []))
(defn select-child-geometry-modifiers
[modifiers]
(-> modifiers select-child select-geometry))
(defn select-child-structre-modifiers
[modifiers]
(-> modifiers select-child select-structure))
@ -601,7 +588,7 @@
;; Main transformation functions
(defn transform-move!
(defn- transform-move!
"Transforms a matrix by the translation modifier"
[matrix modifier]
(-> (dm/get-prop modifier :vector)
@ -609,7 +596,7 @@
(gmt/multiply! matrix)))
(defn transform-resize!
(defn- transform-resize!
"Transforms a matrix by the resize modifier"
[matrix modifier]
(let [tf (dm/get-prop modifier :transform)
@ -631,7 +618,7 @@
(gmt/multiply! tfi)))
matrix)))
(defn transform-rotate!
(defn- transform-rotate!
"Transforms a matrix by the rotation modifier"
[matrix modifier]
(let [center (dm/get-prop modifier :center)
@ -643,7 +630,7 @@
(gmt/translate! (gpt/negate center)))
matrix)))
(defn transform!
(defn- transform!
"Returns a matrix transformed by the modifier"
[matrix modifier]
(let [type (dm/get-prop modifier :type)]
@ -652,8 +639,7 @@
:resize (transform-resize! matrix modifier)
:rotation (transform-rotate! matrix modifier))))
(defn modifiers->transform1
"A multiplatform version of modifiers->transform."
(defn- modifiers->transform1
[modifiers]
(reduce transform! (gmt/matrix) modifiers))
@ -665,80 +651,28 @@
modifiers (sort-by #(dm/get-prop % :order) modifiers)]
(modifiers->transform1 modifiers)))
(defn modifiers->transform-old
"Given a set of modifiers returns its transformation matrix"
[modifiers]
(let [modifiers (->> (concat (dm/get-prop modifiers :geometry-parent)
(dm/get-prop modifiers :geometry-child))
(sort-by :order))]
(loop [matrix (gmt/matrix)
modifiers (seq modifiers)]
(if (c/empty? modifiers)
matrix
(let [modifier (first modifiers)
type (dm/get-prop modifier :type)
matrix
(case type
:move
(-> (dm/get-prop modifier :vector)
(gmt/translate-matrix)
(gmt/multiply! matrix))
:resize
(let [tf (dm/get-prop modifier :transform)
tfi (dm/get-prop modifier :transform-inverse)
vector (dm/get-prop modifier :vector)
origin (dm/get-prop modifier :origin)
origin (if ^boolean (some? tfi)
(gpt/transform origin tfi)
origin)]
(gmt/multiply!
(-> (gmt/matrix)
(cond-> ^boolean (some? tf)
(gmt/multiply! tf))
(gmt/translate! origin)
(gmt/scale! vector)
(gmt/translate! (gpt/negate origin))
(cond-> ^boolean (some? tfi)
(gmt/multiply! tfi)))
matrix))
:rotation
(let [center (dm/get-prop modifier :center)
rotation (dm/get-prop modifier :rotation)]
(gmt/multiply!
(-> (gmt/matrix)
(gmt/translate! center)
(gmt/multiply! (gmt/rotate-matrix rotation))
(gmt/translate! (gpt/negate center)))
matrix)))]
(recur matrix (next modifiers)))))))
(defn transform-text-node [value attrs]
(defn- transform-text-node [value attrs]
(let [font-size (-> (get attrs :font-size 14) d/parse-double (* value) str)
letter-spacing (-> (get attrs :letter-spacing 0) d/parse-double (* value) str)]
(d/txt-merge attrs {:font-size font-size
:letter-spacing letter-spacing})))
(defn transform-paragraph-node [value attrs]
(defn- transform-paragraph-node [value attrs]
(let [font-size (-> (get attrs :font-size 14) d/parse-double (* value) str)]
(d/txt-merge attrs {:font-size font-size})))
(defn update-text-content
(defn- update-text-content
[shape scale-text-content value]
(update shape :content scale-text-content value))
(defn scale-text-content
(defn- scale-text-content
[content value]
(->> content
(txt/transform-nodes txt/is-text-node? (partial transform-text-node value))
(txt/transform-nodes txt/is-paragraph-node? (partial transform-paragraph-node value))))
(defn apply-scale-content
(defn- apply-scale-content
[shape value]
;; Scale can only be positive
(let [value (mth/abs value)]
@ -767,7 +701,7 @@
:always
(ctl/update-flex-child value))))
(defn remove-children-set
(defn- remove-children-set
[shapes children-to-remove]
(let [remove? (set children-to-remove)]
(d/removev remove? shapes)))

633
common/test/common_tests/types/modifiers_test.cljc
View File

@ -8,7 +8,13 @@
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.schema :as sm]
[app.common.types.modifiers :as ctm]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[clojure.test :as t]))
(t/deftest modifiers->transform
@ -24,3 +30,630 @@
transform (ctm/modifiers->transform modifiers)]
(t/is (not (gmt/close? (gmt/matrix) transform)))))
;; ─── Helpers ──────────────────────────────────────────────────────────────────
(defn- make-shape
"Build a minimal axis-aligned rect shape with the given geometry."
([width height]
(make-shape 0 0 width height))
([x y width height]
(cts/setup-shape {:type :rect :x x :y y :width width :height height})))
(defn- make-shape-with-proportion
"Build a shape with a fixed proportion ratio and proportion-lock enabled."
[width height]
(assoc (make-shape width height)
:proportion (/ (float width) (float height))
:proportion-lock true))
(defn- resize-op
"Extract the single resize GeometricOperation from geometry-child."
[modifiers]
(first (:geometry-child modifiers)))
;; ─── change-size ──────────────────────────────────────────────────────────────
(t/deftest change-size-basic
(t/testing "scales both axes to the requested dimensions"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "origin is the first point of the shape (top-left)"
(let [shape (make-shape 10 20 100 50)
mods (ctm/change-size shape 200 50)
origin (:origin (resize-op mods))]
(t/is (mth/close? 10.0 (:x origin)))
(t/is (mth/close? 20.0 (:y origin)))))
(t/testing "nil width falls back to current width, keeping x-scale at 1"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape nil 100)
op (resize-op mods)]
(t/is (mth/close? 1.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "nil height falls back to current height, keeping y-scale at 1"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape 200 nil)
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 1.0 (-> op :vector :y)))))
(t/testing "both nil produces an identity resize (scale 1,1)"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape nil nil)
op (resize-op mods)]
;; Identity resize is optimized away; geometry-child should be empty.
(t/is (empty? (:geometry-child mods)))))
(t/testing "transform and transform-inverse on a plain shape are both the identity matrix"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (gmt/close? (gmt/matrix) (:transform op)))
(t/is (gmt/close? (gmt/matrix) (:transform-inverse op))))))
;; ─── change-dimensions-modifiers ──────────────────────────────────────────────
(t/deftest change-dimensions-modifiers-no-lock
(t/testing "changing width only scales x-axis; y-scale stays 1"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :width 200)
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 1.0 (-> op :vector :y)))))
(t/testing "changing height only scales y-axis; x-scale stays 1"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :height 100)
op (resize-op mods)]
(t/is (mth/close? 1.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "origin is always the top-left point of the shape"
(let [shape (make-shape 30 40 100 50)
mods (ctm/change-dimensions-modifiers shape :width 200)
origin (:origin (resize-op mods))]
(t/is (mth/close? 30.0 (:x origin)))
(t/is (mth/close? 40.0 (:y origin))))))
(t/deftest change-dimensions-modifiers-with-proportion-lock
(t/testing "locking width also adjusts height by the inverse proportion"
;; shape 100x50 → proportion = 100/50 = 2
;; new width 200 → expected height = 200/2 = 100 → scaley = 100/50 = 2
(let [shape (make-shape-with-proportion 100 50)
mods (ctm/change-dimensions-modifiers shape :width 200)
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "locking height also adjusts width by the proportion"
;; shape 100x50 → proportion = 100/50 = 2
;; new height 100 → expected width = 100*2 = 200 → scalex = 200/100 = 2
(let [shape (make-shape-with-proportion 100 50)
mods (ctm/change-dimensions-modifiers shape :height 100)
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "ignore-lock? true bypasses proportion lock"
(let [shape (make-shape-with-proportion 100 50)
mods (ctm/change-dimensions-modifiers shape :width 200 {:ignore-lock? true})
op (resize-op mods)]
(t/is (mth/close? 2.0 (-> op :vector :x)))
;; Height should remain unchanged (scale = 1).
(t/is (mth/close? 1.0 (-> op :vector :y))))))
(t/deftest change-dimensions-modifiers-value-clamping
(t/testing "value below 0.01 is clamped to 0.01"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :width 0.001)
op (resize-op mods)]
;; 0.01 / 100 = 0.0001
(t/is (mth/close? 0.0001 (-> op :vector :x)))))
(t/testing "value of exactly 0 is clamped to 0.01"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :height 0)
op (resize-op mods)]
;; 0.01 / 50 = 0.0002
(t/is (mth/close? 0.0002 (-> op :vector :y))))))
(t/deftest change-dimensions-modifiers-end-to-end
(t/testing "applying change-width modifier produces the expected selrect width"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :width 300)
result (gsh/transform-shape (assoc shape :modifiers mods))]
(t/is (mth/close? 300.0 (-> result :selrect :width)))
(t/is (mth/close? 50.0 (-> result :selrect :height)))))
(t/testing "applying change-height modifier produces the expected selrect height"
(let [shape (make-shape 100 50)
mods (ctm/change-dimensions-modifiers shape :height 200)
result (gsh/transform-shape (assoc shape :modifiers mods))]
(t/is (mth/close? 100.0 (-> result :selrect :width)))
(t/is (mth/close? 200.0 (-> result :selrect :height))))))
;; ─── safe-size-rect fallbacks ─────────────────────────────────────────────────
(t/deftest safe-size-rect-fallbacks
(t/testing "valid selrect is returned as-is"
(let [shape (make-shape 100 50)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
;; scale 2,2 means the selrect was valid
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "zero-width selrect falls back to points, producing a valid rect"
;; Corrupt only the selrect dimensions; the shape's points remain valid.
(let [base (make-shape 100 50)
bad-selrect (assoc (:selrect base) :width 0 :height 0)
shape (assoc base :selrect bad-selrect)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (cts/shape? shape))
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "NaN selrect falls back to points"
(let [base (make-shape 100 50)
bad-selrect (assoc (:selrect base) :width ##NaN :height ##NaN)
shape (assoc base :selrect bad-selrect)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (cts/shape? shape))
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "selrect with dimensions exceeding max-safe-int falls back to points"
(let [base (make-shape 100 50)
bad-selrect (assoc (:selrect base) :width (inc sm/max-safe-int) :height (inc sm/max-safe-int))
shape (assoc base :selrect bad-selrect)
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (cts/shape? shape))
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "invalid selrect and no points falls back to top-level shape fields"
;; Null out both selrect and points; the top-level :x/:y/:width/:height
;; fields on the Shape record are still valid and serve as fallback 3.
(let [shape (-> (make-shape 100 50)
(assoc :selrect nil)
(assoc :points nil))
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (cts/shape? shape))
(t/is (mth/close? 2.0 (-> op :vector :x)))
(t/is (mth/close? 2.0 (-> op :vector :y)))))
(t/testing "all geometry missing: falls back to empty-rect (0.01 x 0.01)"
;; Null out selrect, points and the top-level dimension fields so that
;; every fallback is exhausted and empty-rect (0.01×0.01) is used.
(let [shape (-> (make-shape 100 50)
(assoc :selrect nil)
(assoc :points nil)
(assoc :width nil)
(assoc :height nil))
mods (ctm/change-size shape 200 100)
op (resize-op mods)]
(t/is (cts/shape? shape))
(t/is (mth/close? (/ 200 0.01) (-> op :vector :x)))
(t/is (mth/close? (/ 100 0.01) (-> op :vector :y))))))
;; ─── Builder functions: geometry-child ────────────────────────────────────────
(t/deftest move-builder
(t/testing "move adds an operation to geometry-child"
(let [mods (ctm/move (ctm/empty) (gpt/point 10 20))]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (= :move (-> mods :geometry-child first :type)))))
(t/testing "move with zero vector is optimised away"
(let [mods (ctm/move (ctm/empty) (gpt/point 0 0))]
(t/is (empty? (:geometry-child mods)))))
(t/testing "two consecutive moves on the same axis are merged into one"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 10 0))
(ctm/move (gpt/point 5 0)))]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (mth/close? 15.0 (-> mods :geometry-child first :vector :x)))))
(t/testing "move with x y arity delegates to vector arity"
(let [mods (ctm/move (ctm/empty) 3 7)]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (mth/close? 3.0 (-> mods :geometry-child first :vector :x)))
(t/is (mth/close? 7.0 (-> mods :geometry-child first :vector :y))))))
(t/deftest resize-builder
(t/testing "resize adds an operation to geometry-child"
(let [mods (ctm/resize (ctm/empty) (gpt/point 2 3) (gpt/point 0 0))]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (= :resize (-> mods :geometry-child first :type)))))
(t/testing "identity resize (scale 1,1) is optimised away"
(let [mods (ctm/resize (ctm/empty) (gpt/point 1 1) (gpt/point 0 0))]
(t/is (empty? (:geometry-child mods)))))
(t/testing "precise? flag keeps near-identity resize"
(let [mods (ctm/resize (ctm/empty) (gpt/point 1 1) (gpt/point 0 0)
nil nil {:precise? true})]
(t/is (= 1 (count (:geometry-child mods))))))
(t/testing "resize stores origin, transform and transform-inverse"
(let [tf (gmt/matrix)
tfi (gmt/matrix)
mods (ctm/resize (ctm/empty) (gpt/point 2 2) (gpt/point 5 10) tf tfi)
op (-> mods :geometry-child first)]
(t/is (mth/close? 5.0 (-> op :origin :x)))
(t/is (mth/close? 10.0 (-> op :origin :y)))
(t/is (gmt/close? tf (:transform op)))
(t/is (gmt/close? tfi (:transform-inverse op))))))
(t/deftest rotation-builder
(t/testing "rotation adds ops to both geometry-child and structure-child"
(let [mods (ctm/rotation (ctm/empty) (gpt/point 50 50) 45)]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (= 1 (count (:structure-child mods))))
(t/is (= :rotation (-> mods :geometry-child first :type)))
(t/is (= :rotation (-> mods :structure-child first :type)))))
(t/testing "zero-angle rotation is optimised away"
(let [mods (ctm/rotation (ctm/empty) (gpt/point 50 50) 0)]
(t/is (empty? (:geometry-child mods)))
(t/is (empty? (:structure-child mods))))))
;; ─── Builder functions: geometry-parent ───────────────────────────────────────
(t/deftest move-parent-builder
(t/testing "move-parent adds an operation to geometry-parent, not geometry-child"
(let [mods (ctm/move-parent (ctm/empty) (gpt/point 10 20))]
(t/is (= 1 (count (:geometry-parent mods))))
(t/is (empty? (:geometry-child mods)))
(t/is (= :move (-> mods :geometry-parent first :type)))))
(t/testing "move-parent with zero vector is optimised away"
(let [mods (ctm/move-parent (ctm/empty) (gpt/point 0 0))]
(t/is (empty? (:geometry-parent mods))))))
(t/deftest resize-parent-builder
(t/testing "resize-parent adds an operation to geometry-parent, not geometry-child"
(let [mods (ctm/resize-parent (ctm/empty) (gpt/point 2 3) (gpt/point 0 0))]
(t/is (= 1 (count (:geometry-parent mods))))
(t/is (empty? (:geometry-child mods)))
(t/is (= :resize (-> mods :geometry-parent first :type))))))
;; ─── Builder functions: structure ─────────────────────────────────────────────
(t/deftest structure-builders
(t/testing "add-children appends an add-children op to structure-parent"
(let [id1 (uuid/next)
id2 (uuid/next)
mods (ctm/add-children (ctm/empty) [id1 id2] nil)]
(t/is (= 1 (count (:structure-parent mods))))
(t/is (= :add-children (-> mods :structure-parent first :type)))))
(t/testing "add-children with empty list is a no-op"
(let [mods (ctm/add-children (ctm/empty) [] nil)]
(t/is (empty? (:structure-parent mods)))))
(t/testing "remove-children appends a remove-children op to structure-parent"
(let [id (uuid/next)
mods (ctm/remove-children (ctm/empty) [id])]
(t/is (= 1 (count (:structure-parent mods))))
(t/is (= :remove-children (-> mods :structure-parent first :type)))))
(t/testing "remove-children with empty list is a no-op"
(let [mods (ctm/remove-children (ctm/empty) [])]
(t/is (empty? (:structure-parent mods)))))
(t/testing "reflow appends a reflow op to structure-parent"
(let [mods (ctm/reflow (ctm/empty))]
(t/is (= 1 (count (:structure-parent mods))))
(t/is (= :reflow (-> mods :structure-parent first :type)))))
(t/testing "scale-content appends a scale-content op to structure-child"
(let [mods (ctm/scale-content (ctm/empty) 2.0)]
(t/is (= 1 (count (:structure-child mods))))
(t/is (= :scale-content (-> mods :structure-child first :type)))))
(t/testing "change-property appends a change-property op to structure-parent"
(let [mods (ctm/change-property (ctm/empty) :opacity 0.5)]
(t/is (= 1 (count (:structure-parent mods))))
(t/is (= :change-property (-> mods :structure-parent first :type)))
(t/is (= :opacity (-> mods :structure-parent first :property)))
(t/is (= 0.5 (-> mods :structure-parent first :value))))))
;; ─── Convenience builders ─────────────────────────────────────────────────────
(t/deftest convenience-builders
(t/testing "move-modifiers returns a fresh Modifiers with a move in geometry-child"
(let [mods (ctm/move-modifiers (gpt/point 5 10))]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (= :move (-> mods :geometry-child first :type)))))
(t/testing "move-modifiers accepts x y arity"
(let [mods (ctm/move-modifiers 5 10)]
(t/is (= 1 (count (:geometry-child mods))))))
(t/testing "resize-modifiers returns a fresh Modifiers with a resize in geometry-child"
(let [mods (ctm/resize-modifiers (gpt/point 2 2) (gpt/point 0 0))]
(t/is (= 1 (count (:geometry-child mods))))
(t/is (= :resize (-> mods :geometry-child first :type)))))
(t/testing "reflow-modifiers returns a fresh Modifiers with a reflow in structure-parent"
(let [mods (ctm/reflow-modifiers)]
(t/is (= 1 (count (:structure-parent mods))))
(t/is (= :reflow (-> mods :structure-parent first :type)))))
(t/testing "rotation-modifiers returns move + rotation in geometry-child"
(let [shape (make-shape 100 100)
mods (ctm/rotation-modifiers shape (gpt/point 50 50) 90)]
;; rotation adds a :rotation and a :move to compensate for off-center
(t/is (pos? (count (:geometry-child mods))))
(t/is (some #(= :rotation (:type %)) (:geometry-child mods))))))
;; ─── add-modifiers ────────────────────────────────────────────────────────────
(t/deftest add-modifiers-combinator
(t/testing "combining two disjoint move modifiers sums the vectors"
(let [m1 (ctm/move-modifiers (gpt/point 10 0))
m2 (ctm/move-modifiers (gpt/point 5 0))
result (ctm/add-modifiers m1 m2)]
;; Both are pure geometry-child moves → they get merged
(t/is (= 1 (count (:geometry-child result))))
(t/is (mth/close? 15.0 (-> result :geometry-child first :vector :x)))))
(t/testing "nil first argument is treated as empty"
(let [m2 (ctm/move-modifiers (gpt/point 3 4))
result (ctm/add-modifiers nil m2)]
(t/is (= 1 (count (:geometry-child result))))))
(t/testing "nil second argument is treated as empty"
(let [m1 (ctm/move-modifiers (gpt/point 3 4))
result (ctm/add-modifiers m1 nil)]
(t/is (= 1 (count (:geometry-child result))))))
(t/testing "last-order is the sum of both modifiers' orders"
(let [m1 (ctm/move-modifiers (gpt/point 1 0))
m2 (ctm/move-modifiers (gpt/point 2 0))
result (ctm/add-modifiers m1 m2)]
(t/is (= (+ (:last-order m1) (:last-order m2))
(:last-order result))))))
;; ─── Predicates ───────────────────────────────────────────────────────────────
(t/deftest predicate-empty?
(t/testing "fresh empty modifiers is empty?"
(t/is (ctm/empty? (ctm/empty))))
(t/testing "modifiers with a move are not empty?"
(t/is (not (ctm/empty? (ctm/move-modifiers (gpt/point 1 0))))))
(t/testing "modifiers with only a structure op are not empty?"
(t/is (not (ctm/empty? (ctm/reflow-modifiers))))))
(t/deftest predicate-child-modifiers?
(t/testing "move in geometry-child → child-modifiers? true"
(t/is (ctm/child-modifiers? (ctm/move-modifiers (gpt/point 1 0)))))
(t/testing "scale-content in structure-child → child-modifiers? true"
(t/is (ctm/child-modifiers? (ctm/scale-content (ctm/empty) 2.0))))
(t/testing "move-parent in geometry-parent only → child-modifiers? false"
(t/is (not (ctm/child-modifiers? (ctm/move-parent (ctm/empty) (gpt/point 1 0)))))))
(t/deftest predicate-has-geometry?
(t/testing "move in geometry-child → has-geometry? true"
(t/is (ctm/has-geometry? (ctm/move-modifiers (gpt/point 1 0)))))
(t/testing "move-parent in geometry-parent → has-geometry? true"
(t/is (ctm/has-geometry? (ctm/move-parent (ctm/empty) (gpt/point 1 0)))))
(t/testing "only structure ops → has-geometry? false"
(t/is (not (ctm/has-geometry? (ctm/reflow-modifiers))))))
(t/deftest predicate-has-structure?
(t/testing "reflow op in structure-parent → has-structure? true"
(t/is (ctm/has-structure? (ctm/reflow-modifiers))))
(t/testing "scale-content in structure-child → has-structure? true"
(t/is (ctm/has-structure? (ctm/scale-content (ctm/empty) 2.0))))
(t/testing "only geometry ops → has-structure? false"
(t/is (not (ctm/has-structure? (ctm/move-modifiers (gpt/point 1 0)))))))
(t/deftest predicate-has-structure-child?
(t/testing "scale-content in structure-child → has-structure-child? true"
(t/is (ctm/has-structure-child? (ctm/scale-content (ctm/empty) 2.0))))
(t/testing "reflow in structure-parent only → has-structure-child? false"
(t/is (not (ctm/has-structure-child? (ctm/reflow-modifiers))))))
(t/deftest predicate-only-move?
(t/testing "pure move modifiers → only-move? true"
(t/is (ctm/only-move? (ctm/move-modifiers (gpt/point 1 0)))))
(t/testing "resize modifiers → only-move? false"
(t/is (not (ctm/only-move? (ctm/resize-modifiers (gpt/point 2 2) (gpt/point 0 0))))))
(t/testing "structure ops present → only-move? false"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 1 0))
(ctm/reflow))]
(t/is (not (ctm/only-move? mods)))))
(t/testing "empty modifiers → only-move? true (vacuously)"
(t/is (ctm/only-move? (ctm/empty)))))
;; ─── Projection functions ──────────────────────────────────────────────────────
(t/deftest projection-select-child
(t/testing "select-child keeps geometry-child and structure-child, clears parent"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 1 0))
(ctm/move-parent (gpt/point 2 0))
(ctm/reflow)
(ctm/scale-content 2.0))
result (ctm/select-child mods)]
(t/is (= 1 (count (:geometry-child result))))
(t/is (= 1 (count (:structure-child result))))
(t/is (empty? (:geometry-parent result)))
(t/is (empty? (:structure-parent result))))))
(t/deftest projection-select-parent
(t/testing "select-parent keeps geometry-parent and structure-parent, clears child"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 1 0))
(ctm/move-parent (gpt/point 2 0))
(ctm/reflow)
(ctm/scale-content 2.0))
result (ctm/select-parent mods)]
(t/is (= 1 (count (:geometry-parent result))))
(t/is (= 1 (count (:structure-parent result))))
(t/is (empty? (:geometry-child result)))
(t/is (empty? (:structure-child result))))))
(t/deftest projection-select-geometry
(t/testing "select-geometry keeps both geometry lists, clears structure"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 1 0))
(ctm/move-parent (gpt/point 2 0))
(ctm/reflow)
(ctm/scale-content 2.0))
result (ctm/select-geometry mods)]
(t/is (= 1 (count (:geometry-child result))))
(t/is (= 1 (count (:geometry-parent result))))
(t/is (empty? (:structure-child result)))
(t/is (empty? (:structure-parent result))))))
(t/deftest projection-select-child-structre-modifiers
(t/testing "select-child-structre-modifiers keeps only structure-child"
(let [mods (-> (ctm/empty)
(ctm/move (gpt/point 1 0))
(ctm/move-parent (gpt/point 2 0))
(ctm/reflow)
(ctm/scale-content 2.0))
result (ctm/select-child-structre-modifiers mods)]
(t/is (= 1 (count (:structure-child result))))
(t/is (empty? (:geometry-child result)))
(t/is (empty? (:geometry-parent result)))
(t/is (empty? (:structure-parent result))))))
;; ─── added-children-frames ────────────────────────────────────────────────────
(t/deftest added-children-frames-test
(t/testing "returns frame/shape pairs for add-children operations"
(let [frame-id (uuid/next)
shape-id (uuid/next)
mods (ctm/add-children (ctm/empty) [shape-id] nil)
tree {frame-id {:modifiers mods}}
result (ctm/added-children-frames tree)]
(t/is (= 1 (count result)))
(t/is (= frame-id (:frame (first result))))
(t/is (= shape-id (:shape (first result))))))
(t/testing "returns empty when there are no add-children operations"
(let [frame-id (uuid/next)
mods (ctm/reflow-modifiers)
tree {frame-id {:modifiers mods}}
result (ctm/added-children-frames tree)]
(t/is (empty? result))))
(t/testing "returns empty for an empty modif-tree"
(t/is (empty? (ctm/added-children-frames {})))))
;; ─── apply-modifier and apply-structure-modifiers ─────────────────────────────
(t/deftest apply-modifier-test
(t/testing "rotation op increments shape :rotation field"
(let [shape (make-shape 100 50)
op (-> (ctm/rotation (ctm/empty) (gpt/point 50 25) 90)
:structure-child
first)
result (ctm/apply-modifier shape op)]
(t/is (mth/close? 90.0 (:rotation result)))))
(t/testing "rotation wraps around 360"
(let [shape (assoc (make-shape 100 50) :rotation 350)
op (-> (ctm/rotation (ctm/empty) (gpt/point 50 25) 20)
:structure-child
first)
result (ctm/apply-modifier shape op)]
(t/is (mth/close? 10.0 (:rotation result)))))
(t/testing "add-children op appends ids to shape :shapes"
(let [id1 (uuid/next)
id2 (uuid/next)
shape (assoc (make-shape 100 50) :shapes [])
op (-> (ctm/add-children (ctm/empty) [id1 id2] nil)
:structure-parent
first)
result (ctm/apply-modifier shape op)]
(t/is (= [id1 id2] (:shapes result)))))
(t/testing "add-children op with index inserts at the given position"
(let [id-existing (uuid/next)
id-new (uuid/next)
shape (assoc (make-shape 100 50) :shapes [id-existing])
op (-> (ctm/add-children (ctm/empty) [id-new] 0)
:structure-parent
first)
result (ctm/apply-modifier shape op)]
(t/is (= id-new (first (:shapes result))))))
(t/testing "remove-children op removes given ids from shape :shapes"
(let [id1 (uuid/next)
id2 (uuid/next)
shape (assoc (make-shape 100 50) :shapes [id1 id2])
op (-> (ctm/remove-children (ctm/empty) [id1])
:structure-parent
first)
result (ctm/apply-modifier shape op)]
(t/is (= [id2] (:shapes result)))))
(t/testing "change-property op sets the property on the shape"
(let [shape (make-shape 100 50)
op (-> (ctm/change-property (ctm/empty) :opacity 0.5)
:structure-parent
first)
result (ctm/apply-modifier shape op)]
(t/is (= 0.5 (:opacity result)))))
(t/testing "unknown op type returns shape unchanged"
(let [shape (make-shape 100 50)
result (ctm/apply-modifier shape {:type :unknown})]
(t/is (= shape result)))))
(t/deftest apply-structure-modifiers-test
(t/testing "applies structure-parent and structure-child ops in order"
(let [id (uuid/next)
shape (assoc (make-shape 100 50) :shapes [])
mods (-> (ctm/empty)
(ctm/add-children [id] nil)
(ctm/scale-content 1.0))
result (ctm/apply-structure-modifiers shape mods)]
(t/is (= [id] (:shapes result)))))
(t/testing "empty modifiers returns shape unchanged"
(let [shape (make-shape 100 50)
result (ctm/apply-structure-modifiers shape (ctm/empty))]
(t/is (= shape result))))
(t/testing "change-property in structure-parent is applied"
(let [shape (make-shape 100 50)
mods (ctm/change-property (ctm/empty) :opacity 0.3)
result (ctm/apply-structure-modifiers shape mods)]
(t/is (= 0.3 (:opacity result)))))
(t/testing "rotation in structure-child is applied"
(let [shape (make-shape 100 50)
mods (ctm/rotation (ctm/empty) (gpt/point 50 25) 45)
result (ctm/apply-structure-modifiers shape mods)]
(t/is (mth/close? 45.0 (:rotation result))))))

33
frontend/src/app/main/data/workspace/texts.cljs
View File

@ -618,27 +618,30 @@
(assoc-in [:workspace-global :default-font] data))))))
(defn apply-text-modifier
[shape {:keys [width height position-data]}]
[shape text-modifier]
(let [new-shape
(cond-> shape
(some? width)
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :width width {:ignore-lock? true}))
(if (some? text-modifier)
(let [{:keys [width height position-data]} text-modifier
new-shape
(cond-> shape
(some? width)
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :width width {:ignore-lock? true}))
(some? height)
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :height height {:ignore-lock? true}))
(some? height)
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :height height {:ignore-lock? true}))
(some? position-data)
(assoc :position-data position-data))
(some? position-data)
(assoc :position-data position-data))
delta-move
(gpt/subtract (gpt/point (:selrect new-shape))
(gpt/point (:selrect shape)))
delta-move
(gpt/subtract (gpt/point (ctm/safe-size-rect new-shape))
(gpt/point (ctm/safe-size-rect shape)))
new-shape
(update new-shape :position-data gsh/move-position-data delta-move)]
new-shape
(update new-shape :position-data gsh/move-position-data delta-move)]
new-shape))
new-shape)
shape))
(defn commit-update-text-modifier
[]

2
frontend/src/app/main/ui/workspace/shapes/text.cljs
View File

@ -27,7 +27,7 @@
text-modifier
(mf/deref text-modifier-ref)
shape (if (some? shape)
shape (if (and (some? shape) (some? text-modifier))
(dwt/apply-text-modifier shape text-modifier)
shape)]

274
frontend/test/frontend_tests/data/workspace_texts_test.cljs Normal file
View File

@ -0,0 +1,274 @@
;; 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-texts-test
(:require
[app.common.geom.rect :as grc]
[app.common.types.shape :as cts]
[app.main.data.workspace.texts :as dwt]
[cljs.test :as t :include-macros true]))
;; ---------------------------------------------------------------------------
;; Helpers
;; ---------------------------------------------------------------------------
(defn- make-text-shape
"Build a fully initialised text shape at the given position."
[& {:keys [x y width height position-data]
:or {x 10 y 20 width 100 height 50}}]
(cond-> (cts/setup-shape {:type :text
:x x
:y y
:width width
:height height})
(some? position-data)
(assoc :position-data position-data)))
(defn- make-degenerate-text-shape
"Simulate a text shape decoded from the server via map->Rect (which bypasses
make-rect's 0.01 minimum enforcement), giving it a zero-width / zero-height
selrect. This is the exact condition that triggered the original crash:
change-dimensions-modifiers divided by sr-width (== 0), producing an Infinity
scale factor that propagated through the transform pipeline until
calculate-selrect / center->rect returned nil, and then gpt/point threw
'invalid arguments (on pointer constructor)'."
[& {:keys [x y width height]
:or {x 10 y 20 width 0 height 0}}]
(-> (make-text-shape :x x :y y :width 100 :height 50)
;; Bypass make-rect by constructing the Rect record directly, the same
;; way decode-rect does during JSON deserialization from the backend.
(assoc :selrect (grc/map->Rect {:x x :y y
:width width :height height
:x1 x :y1 y
:x2 (+ x width) :y2 (+ y height)}))))
(defn- sample-position-data
"Return a minimal position-data vector with the supplied coords."
[x y]
[{:x x :y y :width 80 :height 16 :fills [] :text "hello"}])
;; ---------------------------------------------------------------------------
;; Tests: nil / no-op guard
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-nil-modifier-returns-shape-unchanged
(t/testing "nil text-modifier returns the original shape untouched"
(let [shape (make-text-shape)
result (dwt/apply-text-modifier shape nil)]
(t/is (= shape result)))))
(t/deftest apply-text-modifier-empty-map-no-keys-returns-shape-unchanged
(t/testing "modifier with no recognised keys leaves shape unchanged"
(let [shape (make-text-shape)
modifier {}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= (:selrect shape) (:selrect result)))
(t/is (= (:width result) (:width shape)))
(t/is (= (:height result) (:height shape))))))
;; ---------------------------------------------------------------------------
;; Tests: width modifier
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-width-changes-shape-width
(t/testing "width modifier resizes the shape width"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:width 200}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= 200.0 (-> result :selrect :width))))))
(t/deftest apply-text-modifier-width-nil-skips-width-change
(t/testing "nil :width in modifier does not alter the width"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:width nil}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= (-> shape :selrect :width) (-> result :selrect :width))))))
;; ---------------------------------------------------------------------------
;; Tests: height modifier
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-height-changes-shape-height
(t/testing "height modifier resizes the shape height"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:height 120}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= 120.0 (-> result :selrect :height))))))
(t/deftest apply-text-modifier-height-nil-skips-height-change
(t/testing "nil :height in modifier does not alter the height"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:height nil}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= (-> shape :selrect :height) (-> result :selrect :height))))))
;; ---------------------------------------------------------------------------
;; Tests: width + height together
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-width-and-height-both-applied
(t/testing "both width and height are applied simultaneously"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:width 300 :height 80}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= 300.0 (-> result :selrect :width)))
(t/is (= 80.0 (-> result :selrect :height))))))
;; ---------------------------------------------------------------------------
;; Tests: position-data modifier
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-position-data-is-set-on-shape
(t/testing "position-data modifier replaces the position-data on shape"
(let [pd (sample-position-data 5 10)
shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:position-data pd}
result (dwt/apply-text-modifier shape modifier)]
(t/is (some? (:position-data result))))))
(t/deftest apply-text-modifier-position-data-nil-leaves-position-data-unchanged
(t/testing "nil :position-data in modifier does not alter position-data"
(let [pd (sample-position-data 5 10)
shape (-> (make-text-shape :x 0 :y 0 :width 100 :height 50)
(assoc :position-data pd))
modifier {:position-data nil}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= pd (:position-data result))))))
;; ---------------------------------------------------------------------------
;; Tests: position-data is translated by delta when shape moves
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-position-data-translated-on-resize
(t/testing "position-data x/y is adjusted by the delta of the selrect origin"
(let [pd (sample-position-data 10 20)
shape (-> (make-text-shape :x 0 :y 0 :width 100 :height 50)
(assoc :position-data pd))
;; Only set position-data; no resize so no origin shift expected
modifier {:position-data pd}
result (dwt/apply-text-modifier shape modifier)]
;; Delta should be zero (no dimension change), so coords stay the same
(t/is (= 10.0 (-> result :position-data first :x)))
(t/is (= 20.0 (-> result :position-data first :y))))))
(t/deftest apply-text-modifier-position-data-not-translated-when-nil
(t/testing "nil position-data on result after modifier is left as nil"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:width 200}
result (dwt/apply-text-modifier shape modifier)]
;; shape had no position-data; modifier doesn't set one — stays nil
(t/is (nil? (:position-data result))))))
;; ---------------------------------------------------------------------------
;; Tests: degenerate selrect (zero width or height decoded from the server)
;;
;; Root cause of the original crash:
;; change-dimensions-modifiers divided by (:width selrect) or (:height selrect)
;; which is 0 when the shape was decoded via map->Rect (bypassing make-rect's
;; 0.01 minimum), producing Infinity → transform pipeline returned nil selrect
;; → gpt/point threw "invalid arguments (on pointer constructor)".
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-zero-width-selrect-does-not-throw
(t/testing "width modifier on a shape with zero selrect width does not throw"
;; Simulates a shape received from the server whose selrect has width=0
;; (map->Rect bypasses the 0.01 floor of make-rect).
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 50)
modifier {:width 200}
result (dwt/apply-text-modifier shape modifier)]
(t/is (some? result))
(t/is (some? (:selrect result))))))
(t/deftest apply-text-modifier-zero-height-selrect-does-not-throw
(t/testing "height modifier on a shape with zero selrect height does not throw"
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 100 :height 0)
modifier {:height 80}
result (dwt/apply-text-modifier shape modifier)]
(t/is (some? result))
(t/is (some? (:selrect result))))))
(t/deftest apply-text-modifier-zero-width-and-height-selrect-does-not-throw
(t/testing "both modifiers on a fully-degenerate selrect do not throw"
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 0)
modifier {:width 150 :height 60}
result (dwt/apply-text-modifier shape modifier)]
(t/is (some? result))
(t/is (some? (:selrect result))))))
(t/deftest apply-text-modifier-zero-width-selrect-result-has-correct-width
(t/testing "applying width modifier to a zero-width shape yields the requested width"
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 50)
modifier {:width 200}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= 200.0 (-> result :selrect :width))))))
(t/deftest apply-text-modifier-zero-height-selrect-result-has-correct-height
(t/testing "applying height modifier to a zero-height shape yields the requested height"
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 100 :height 0)
modifier {:height 80}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= 80.0 (-> result :selrect :height))))))
(t/deftest apply-text-modifier-nil-modifier-on-degenerate-shape-returns-unchanged
(t/testing "nil modifier on a zero-selrect shape returns the same shape"
(let [shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 0)
result (dwt/apply-text-modifier shape nil)]
(t/is (identical? shape result)))))
;; ---------------------------------------------------------------------------
;; Tests: shape origin is preserved when there is no dimension change
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-selrect-origin-preserved-without-resize
(t/testing "selrect x/y origin does not shift when no dimension changes"
(let [shape (make-text-shape :x 30 :y 40 :width 100 :height 50)
modifier {:position-data (sample-position-data 30 40)}
result (dwt/apply-text-modifier shape modifier)]
(t/is (= (-> shape :selrect :x) (-> result :selrect :x)))
(t/is (= (-> shape :selrect :y) (-> result :selrect :y))))))
;; ---------------------------------------------------------------------------
;; Tests: returned shape is a proper map-like value
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-returns-shape-with-required-keys
(t/testing "result always contains the core shape keys"
(let [shape (make-text-shape :x 0 :y 0 :width 100 :height 50)
modifier {:width 200 :height 80}
result (dwt/apply-text-modifier shape modifier)]
(t/is (some? (:id result)))
(t/is (some? (:type result)))
(t/is (some? (:selrect result))))))
(t/deftest apply-text-modifier-nil-modifier-returns-same-identity
(t/testing "nil modifier returns the exact same shape object (identity)"
(let [shape (make-text-shape)]
(t/is (identical? shape (dwt/apply-text-modifier shape nil))))))
;; ---------------------------------------------------------------------------
;; Tests: delta-move computation does not throw on degenerate selrect
;;
;; The delta-move in apply-text-modifier calls gpt/point on both the
;; original and new shape selrects. gpt/point throws when given a
;; non-point-like value (nil, or a map with non-finite :x/:y). Using
;; ctm/safe-size-rect instead of raw (:selrect …) access ensures a valid
;; rect is always available for that computation.
;; ---------------------------------------------------------------------------
(t/deftest apply-text-modifier-position-data-with-degenerate-selrect-does-not-throw
(t/testing "position-data modifier on a zero-selrect shape does not throw"
(let [pd (sample-position-data 5 10)
shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 0)
result (dwt/apply-text-modifier shape {:position-data pd})]
(t/is (some? result))
(t/is (= pd (:position-data result)))))
(t/testing "width + position-data modifier on a zero-selrect shape does not throw"
(let [pd (sample-position-data 5 10)
shape (make-degenerate-text-shape :x 0 :y 0 :width 0 :height 0)
result (dwt/apply-text-modifier shape {:width 200 :position-data pd})]
(t/is (some? result))
(t/is (some? (:selrect result))))))

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

@ -3,6 +3,7 @@
[cljs.test :as t]
[frontend-tests.basic-shapes-test]
[frontend-tests.data.workspace-colors-test]
[frontend-tests.data.workspace-texts-test]
[frontend-tests.helpers-shapes-test]
[frontend-tests.logic.comp-remove-swap-slots-test]
[frontend-tests.logic.components-and-tokens]
@ -36,6 +37,7 @@
(t/run-tests
'frontend-tests.basic-shapes-test
'frontend-tests.data.workspace-colors-test
'frontend-tests.data.workspace-texts-test
'frontend-tests.helpers-shapes-test
'frontend-tests.logic.comp-remove-swap-slots-test
'frontend-tests.logic.components-and-tokens