🚧 WIP Step 4, frames and groups

frontend/test/benches/render_wasm/scenes/builder.clj

@@ -16,7 +16,10 @@
       (rect)                  ; anonymous, generated attrs
       (rect {:x 10})          ; literal x over the generated rest
       (rect :hero {})         ; label stored in instance :refs
-      (rect [:tile 3] {}))    ; vector label stored in instance :refs
+      (frame {:x 0 :y 0 :width 100 :height 100}
+        (rect))
+      (group :tiles {}
+        (rect [:tile 3] {})))
 
   `params` is a map with `:seed` (required), optional `:root` attributes for
   the canonical root frame, and optional `:defaults` with one attribute
@@ -68,3 +71,46 @@
      benches.render-wasm.scenes.builder/*defaults*
      ~label
      ~attrs)))
+
+(defmacro frame
+  "Adds a frame to the current scope, runs `body` with the frame as parent,
+  and returns the frame uuid.
+
+  Forms: `(frame attrs & body)` and `(frame label attrs & body)`. `label` is
+  a literal keyword or vector stored in the instance `:refs`. Frame attrs
+  must carry `:x :y :width :height`; children keep page-absolute
+  coordinates. Empty frames are allowed."
+  [label-or-attrs & body]
+  (if (or (keyword? label-or-attrs) (vector? label-or-attrs))
+    `(benches.render-wasm.scenes.builder/with-container
+       :frame
+       ~(first body)
+       ~label-or-attrs
+       (fn [] ~@(rest body)))
+    `(benches.render-wasm.scenes.builder/with-container
+       :frame
+       ~label-or-attrs
+       nil
+       (fn [] ~@body))))
+
+(defmacro group
+  "Adds a group to the current scope, runs `body` with the group as parent,
+  and returns the group uuid.
+
+  Forms: `(group attrs & body)` and `(group label attrs & body)`. `label` is
+  a literal keyword or vector stored in the instance `:refs`. Groups derive
+  their geometry from children, so geometry attrs are rejected. With
+  `:masked-group true` the first child is the mask. A group needs at least
+  one child."
+  [label-or-attrs & body]
+  (if (or (keyword? label-or-attrs) (vector? label-or-attrs))
+    `(benches.render-wasm.scenes.builder/with-container
+       :group
+       ~(first body)
+       ~label-or-attrs
+       (fn [] ~@(rest body)))
+    `(benches.render-wasm.scenes.builder/with-container
+       :group
+       ~label-or-attrs
+       nil
+       (fn [] ~@body))))

frontend/test/benches/render_wasm/scenes/builder.cljs

@@ -8,24 +8,36 @@
   "Scoped construction for renderer benchmark fixtures.
 
   A fixture scope owns one seeded generator, one object map, and one label
-  map. `(shape ...)` calls add shapes to the tree.
+  map. Shape constructors add themselves to the current parent: `rect`, and
+  the `frame`/`group` container scopes. The scope returns a validated
+  snapshot in the ticket02 contract `{:objects ... :refs ...}`.
 
-  Construction is synchronous by design: the scope is carried by a dynamic
-  var, so `let`, `doseq` and functions defined outside the scope all work
-  inside a fixture, while fixture scopes cannot nest and body exceptions
-  unwind without leaving state behind.
+  Construction is synchronous by design: the scope and the current parent
+  are carried by dynamic vars, so `let`, `doseq` and functions defined
+  outside the scope all work inside a fixture. Fixture scopes cannot nest
+  and body exceptions unwind without leaving state behind. A container whose
+  body throws is marked unfinished and `finish!` rejects the instance, so a
+  caught exception cannot silently produce a half-built scene.
 
   Defaults follow the same theme: `*defaults*` maps a shape type to an
   attribute generator map, bound by the `fixture` macro from the scope
   params. Per-shape attrs are merged over the generated values, so a recipe
   can override anything locally and rebind `*defaults*` around a section.
 
-  Frame/group scopes are ticket18; booleans ticket19; paths ticket07/08."
+  Coordinates stay page-absolute: nesting supplies ownership and order, not
+  translation. Frames keep authored bounds; groups derive bounds from their
+  children inside out; a masked group takes the geometry of its first child.
+
+  Masked groups, frame/group scopes are this ticket; booleans ticket19;
+  paths ticket07/08."
   (:require
+   [app.common.data :as d]
+   [app.common.geom.shapes :as gsh]
    [app.common.types.color :as clr]
    [app.common.types.shape :as cts]
+   [app.common.types.shape-tree :as ctst]
    [app.common.uuid :as uuid]
-   [benches.render-wasm.scenes.common :as sc]))
+   [benches.render-wasm.scenes.common :as common]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Poor-man's seeded PRNG
@@ -142,11 +154,10 @@
   functions of the scope random source."
   {})
 
-(defn- ensure-state
-  [state]
-  (or state
-      (throw (ex-info "rect used outside a fixture scope"
-                      {:type ::outside-scope}))))
+(def ^:dynamic *parent*
+  "Current insertion point as `{:id parent-id :frame-id containing-frame}`;
+  bound by the container scopes, `uuid/zero` at the top."
+  {:id uuid/zero :frame-id uuid/zero})
 
 (defn- check-seed!
   [seed]
@@ -173,7 +184,14 @@
     (atom {:seed seed
            :rng (make-random seed)
            :objects {uuid/zero root}
-           :refs {}})))
+           :refs {}
+           :unfinished {}})))
+
+(defn- ensure-state
+  [state]
+  (or state
+      (throw (ex-info "shape used outside a fixture scope"
+                      {:type ::outside-scope}))))
 
 (defn- resolve-attr
   [rng spec]
@@ -196,6 +214,19 @@
                        :label label})))
     (swap! state assoc-in [:refs label] id)))
 
+(defn- add-object!
+  "Inserts `shape` under the current parent and registers `label`."
+  [state label shape]
+  (let [{:keys [id frame-id]} *parent*]
+    (register-ref! state label (:id shape))
+    (swap! state
+           (fn [scope]
+             (ctst/add-shape (:id shape) shape scope frame-id id nil true)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Shape constructors
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn- normalize-label-and-attrs
   "Resolves the one-argument `rect` form at runtime: a map is attrs, any
   other value is a label. Rejects label types outside keywords and
@@ -210,8 +241,8 @@
                            :label label}))))
 
 (defn rect!
-  "Adds one rectangle to the scope and returns its uuid. This is the primitive
-  behind the `rect` macro."
+  "Adds one rectangle to the scope and returns its uuid. Explicit runtime
+  primitive behind the `rect` macro."
   [state defaults label attrs]
   (let [state         (ensure-state state)
         [label attrs] (normalize-label-and-attrs label attrs)
@@ -220,21 +251,112 @@
         id            (rng-uuid rng)
         shape         (cts/setup-shape (merge attrs
                                               {:id id
-                                               :type :rect
-                                               :parent-id uuid/zero
-                                               :frame-id uuid/zero}))]
-    (register-ref! state label id)
-    (swap! state
-           (fn [scope]
-             (-> scope
-                 (assoc-in [:objects id] shape)
-                 (update-in [:objects uuid/zero :shapes] conj id))))
+                                               :type :rect}))]
+    (add-object! state label shape)
+    id))
+
+(def ^:private frame-bounds-keys
+  [:x :y :width :height])
+
+(def ^:private group-geometry-keys
+  [:x :y :width :height :selrect :points])
+
+(defn- setup-frame
+  [id attrs]
+  (when-not (map? attrs)
+    (throw (ex-info "frame attrs must be a map; the label form takes the attrs map next"
+                    {:type ::invalid-attrs
+                     :id id})))
+  (doseq [key frame-bounds-keys]
+    (let [value (get attrs key)]
+      (cond
+        (nil? value)
+        (throw (ex-info "frame requires :x :y :width :height"
+                        {:type ::frame-bounds
+                         :id id
+                         :missing key}))
+
+        (not (d/num? value))
+        (throw (ex-info "frame bounds must be numbers"
+                        {:type ::frame-bounds
+                         :id id
+                         :invalid key})))))
+  (cts/setup-shape (assoc attrs :id id :type :frame)))
+
+(defn- setup-group
+  [id attrs]
+  (when-not (map? attrs)
+    (throw (ex-info "group attrs must be a map; the label form takes the attrs map next"
+                    {:type ::invalid-attrs
+                     :id id})))
+  (doseq [key group-geometry-keys]
+    (when (some? (get attrs key))
+      (throw (ex-info "group derives its geometry from children"
+                      {:type ::group-geometry
+                       :id id
+                       :key key}))))
+  (cts/setup-shape (assoc attrs :id id :type :group)))
+
+(defn- finalize-group!
+  [state id]
+  (let [scope    @state
+        group    (get-in scope [:objects id])
+        children (mapv (:objects scope) (:shapes group))]
+    (when (empty? children)
+      (throw (ex-info "group requires at least one child"
+                      {:type ::empty-group
+                       :id id})))
+    (let [group (if (:masked-group group)
+                  (gsh/update-mask-selrect group children)
+                  (gsh/update-group-selrect group children))]
+      (swap! state assoc-in [:objects id] group))))
+
+(def ^:private container-specs
+  "Per-container behavior: how to build it, which parent scope it opens,
+  and how to finalize it after the body. Ticket19 extends the table with
+  booleans."
+  {:frame {:setup setup-frame
+           :parent (fn [id _parent] {:id id :frame-id id})
+           :finalize (fn [_state _id] nil)}
+   :group {:setup setup-group
+           :parent (fn [id parent] {:id id :frame-id (:frame-id parent)})
+           :finalize finalize-group!}})
+
+(defn with-container
+  "Creates a frame or group, runs `thunk` with the new parent in scope,
+  finalizes groups, and returns the container uuid.
+
+  Any exception from the body or the finalizer marks the container
+  unfinished and propagates; `finish!` then rejects the instance even if the
+  caller catches the exception."
+  [type attrs label thunk]
+  (let [{:keys [setup parent finalize]}
+        (or (get container-specs type)
+            (throw (ex-info "unsupported container type"
+                            {:type ::invalid-container
+                             :container-type type})))
+        state (ensure-state *state*)
+        id    (rng-uuid (:rng @state))
+        shape (setup id attrs)]
+    (add-object! state label shape)
+    (binding [*parent* (parent id *parent*)]
+      (try
+        (thunk)
+        (finalize state id)
+        (catch :default cause
+          (swap! state assoc-in [:unfinished id] true)
+          (throw cause))))
     id))
 
 (defn finish!
   "Validates the scope snapshot and returns it."
   [state]
-  (let [instance {:objects (:objects @state)
-                  :refs (:refs @state)}]
-    (sc/validate! instance)
-    instance))
+  (let [{:keys [objects refs unfinished]} @state]
+    (when (seq unfinished)
+      (throw (ex-info "fixture contains an unfinished container"
+                      {:type ::unfinished-container
+                       :ids (vec (keys unfinished))})))
+    (let [instance {:objects objects
+                    :refs refs}]
+      (common/validate! instance)
+      instance)))

frontend/test/benches/render_wasm/scenes/rects.cljs

@@ -41,10 +41,10 @@
   [params]
   (let [params (merge default-params params)]
     (sb/fixture {:seed (:seed params)
-                      :root {:x 0
-                             :y 0
-                             :width (:width params)
-                             :height (:height params)}
-                      :defaults {:rect (rect-defaults params)}}
-                     (doseq [_ (range (:count params))]
-                       (sb/rect)))))
+                 :root {:x 0
+                        :y 0
+                        :width (:width params)
+                        :height (:height params)}
+                 :defaults {:rect (rect-defaults params)}}
+                (doseq [_ (range (:count params))]
+                  (sb/rect)))))

frontend/test/frontend_tests/benches/containers_test.cljs

@@ -0,0 +1,261 @@
+;; 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 SUBSIDIARY SL
+
+(ns frontend-tests.benches.containers-test
+  (:require
+   [app.common.uuid :as uuid]
+   [benches.render-wasm.scenes.builder :as builder :include-macros true]
+   [benches.render-wasm.scenes.common :as common]
+   [cljs.test :as t :include-macros true]))
+
+(defn- failure-data
+  [f]
+  (try
+    (f)
+    nil
+    (catch :default cause
+      (ex-data cause))))
+
+(defn- child-ids
+  "Ids listed in the :shapes vector of `id`."
+  [instance id]
+  (get-in instance [:objects id :shapes]))
+
+(defn- children-of
+  "Child shapes of `id` in order."
+  [instance id]
+  (mapv (:objects instance) (child-ids instance id)))
+
+(defn- run-scope
+  "Runs `f` inside a raw scope and returns the scope state, so tests can
+  inspect partial builds without calling finish!."
+  [params f]
+  (let [state (builder/start params)]
+    (binding [builder/*state* state
+              builder/*defaults* {}]
+      (f))
+    state))
+
+(t/deftest frame-attaches-children-in-order
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame {:x 0 :y 0 :width 100 :height 100 :name "F"}
+                                                 (builder/rect {:x 10 :y 10 :width 5 :height 5})
+                                                 (builder/rect {:x 20 :y 20 :width 5 :height 5})))
+        frame    (first (children-of instance uuid/zero))
+        rects    (children-of instance (:id frame))]
+    (t/is (= :frame (:type frame)))
+    (t/is (= [(:id frame)] (child-ids instance uuid/zero)))
+    (t/is (= 2 (count rects)))
+    (t/is (every? #(= (:id frame) (:parent-id %)) rects))
+    (t/is (every? #(= (:id frame) (:frame-id %)) rects))
+    (t/is (= [10 20] (mapv :x rects)))
+    (t/is (= [10 20] (mapv :y rects)))
+    (t/is (= [100 100] [(:width frame) (:height frame)]))))
+
+(t/deftest nested-frames-keep-frame-ids
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame {:x 0 :y 0 :width 100 :height 100 :name "Outer"}
+                                                 (builder/frame {:x 10 :y 10 :width 50 :height 50 :name "Inner"}
+                                                                (builder/rect {:x 20 :y 20 :width 5 :height 5}))))
+        outer    (first (children-of instance uuid/zero))
+        inner    (first (children-of instance (:id outer)))
+        rect     (first (children-of instance (:id inner)))]
+    (t/is (= uuid/zero (:frame-id outer)))
+    (t/is (= (:id outer) (:parent-id inner)))
+    (t/is (= (:id outer) (:frame-id inner)))
+    (t/is (= (:id inner) (:parent-id rect)))
+    (t/is (= (:id inner) (:frame-id rect)))
+    (t/is (= [20 20] [(:x rect) (:y rect)]))))
+
+(t/deftest group-derives-bounds-from-children
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/group {}
+                                                 (builder/rect {:x 10 :y 20 :width 30 :height 40})
+                                                 (builder/rect {:x 50 :y 80 :width 10 :height 10})))
+        group    (first (children-of instance uuid/zero))
+        rects    (children-of instance (:id group))]
+    (t/is (= :group (:type group)))
+    (t/is (= [10 20 50 70]
+             [(:x group) (:y group) (:width group) (:height group)]))
+    (t/is (= [10 20 50 70]
+             [(:x (:selrect group)) (:y (:selrect group))
+              (:width (:selrect group)) (:height (:selrect group))]))
+    (t/is (every? #(= uuid/zero (:frame-id %)) rects))
+    (t/is (every? #(= (:id group) (:parent-id %)) rects))))
+
+(t/deftest nested-groups-derive-inside-out
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/group {:name "Outer"}
+                                                 (builder/rect {:x 0 :y 0 :width 10 :height 10})
+                                                 (builder/group {:name "Inner"}
+                                                                (builder/rect {:x 100 :y 100 :width 10 :height 10}))))
+        outer    (first (children-of instance uuid/zero))
+        inner    (second (children-of instance (:id outer)))]
+    (t/is (= :group (:type inner)))
+    (t/is (= [100 100 10 10]
+             [(:x inner) (:y inner) (:width inner) (:height inner)]))
+    (t/is (= [0 0 110 110]
+             [(:x outer) (:y outer) (:width outer) (:height outer)]))))
+
+(t/deftest group-inside-frame-points-at-the-frame
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame {:x 0 :y 0 :width 200 :height 200}
+                                                 (builder/group {}
+                                                                (builder/rect {:x 10 :y 10 :width 10 :height 10}))))
+        frame    (first (children-of instance uuid/zero))
+        group    (first (children-of instance (:id frame)))
+        rect     (first (children-of instance (:id group)))]
+    (t/is (= (:id frame) (:frame-id group)))
+    (t/is (= (:id frame) (:frame-id rect)))
+    (t/is (= (:id group) (:parent-id rect)))))
+
+(t/deftest masked-group-takes-the-first-child-geometry
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/group {:masked-group true}
+                                                 (builder/rect {:x 10 :y 20 :width 30 :height 40})
+                                                 (builder/rect {:x 0 :y 0 :width 500 :height 500})))
+        group    (first (children-of instance uuid/zero))]
+    (t/is (true? (:masked-group group)))
+    (t/is (= [10 20 30 40]
+             [(:x group) (:y group) (:width group) (:height group)]))))
+
+(t/deftest container-labels-are-instance-local
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame :hero {:x 0 :y 0 :width 10 :height 10}
+                                                 (builder/group [:g 1] {}
+                                                                (builder/rect))))
+        refs     (:refs instance)]
+    (t/is (= #{:hero [:g 1]} (set (keys refs))))
+    (t/is (= (get refs :hero) (first (child-ids instance uuid/zero))))
+    (t/is (= (get refs [:g 1]) (first (child-ids instance (get refs :hero)))))
+    (t/is (= 1 (count (child-ids instance uuid/zero))))))
+
+(t/deftest nested-order-follows-construction
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame {:x 0 :y 0 :width 100 :height 100}
+                                                 (builder/rect)
+                                                 (builder/group {}
+                                                                (builder/rect))))
+        order    (mapv :type (common/upload-order instance))]
+    (t/is (= [:frame :frame :rect :group :rect] order))))
+
+(t/deftest empty-group-is-rejected
+  (let [data (failure-data #(builder/fixture {:seed 1} (builder/group {})))]
+    (t/is (= ::builder/empty-group (:type data)))))
+
+(t/deftest group-geometry-attrs-are-rejected
+  (let [data (failure-data
+              #(builder/fixture {:seed 1}
+                                (builder/group {:x 1}
+                                               (builder/rect))))]
+    (t/is (= ::builder/group-geometry (:type data)))
+    (t/is (= :x (:key data)))))
+
+(t/deftest frame-requires-bounds
+  (let [data (failure-data
+              #(builder/fixture {:seed 1}
+                                (builder/frame {:name "F"}
+                                               (builder/rect))))]
+    (t/is (= ::builder/frame-bounds (:type data)))))
+
+(t/deftest runtime-attrs-expressions-are-accepted
+  (let [frame-attrs {:x 0 :y 0 :width 10 :height 10}
+        instance    (builder/fixture {:seed 1}
+                                     (builder/frame frame-attrs
+                                                    (builder/rect)))
+        frame       (first (children-of instance uuid/zero))]
+    (t/is (= :frame (:type frame)))
+    (t/is (= 10 (:width frame)))))
+
+(t/deftest non-map-attrs-are-rejected
+  (t/is (= ::builder/invalid-attrs
+           (:type (failure-data
+                   #(builder/fixture {:seed 1}
+                                     (builder/frame :hero (builder/rect)))))))
+  (let [state (run-scope {:seed 1}
+                         (fn []
+                           (try
+                             (builder/frame :hero (builder/rect))
+                             (catch :default _ nil))))]
+    (t/is (= 1 (count (child-ids @state uuid/zero))))))
+
+(t/deftest non-numeric-frame-bounds-are-rejected
+  (let [data (failure-data
+              #(builder/fixture {:seed 1}
+                                (builder/frame {:x 0 :y 0 :width "100" :height 10}
+                                               (builder/rect))))]
+    (t/is (= ::builder/frame-bounds (:type data)))
+    (t/is (= :width (:invalid data)))))
+
+(t/deftest duplicate-container-labels-are-rejected
+  (let [data (failure-data
+              #(builder/fixture {:seed 1}
+                                (builder/frame :dup {:x 0 :y 0 :width 10 :height 10}
+                                               (builder/rect))
+                                (builder/group :dup {}
+                                               (builder/rect))))]
+    (t/is (= ::builder/duplicate-label (:type data)))
+    (t/is (= :dup (:label data)))))
+
+(t/deftest frame-inside-group-keeps-frame-ids
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/group {}
+                                                 (builder/frame {:x 0 :y 0 :width 50 :height 50}
+                                                                (builder/rect))))
+        group    (first (children-of instance uuid/zero))
+        frame    (first (children-of instance (:id group)))
+        rect     (first (children-of instance (:id frame)))]
+    (t/is (= (:id group) (:parent-id frame)))
+    (t/is (= uuid/zero (:frame-id frame)))
+    (t/is (= (:id frame) (:parent-id rect)))
+    (t/is (= (:id frame) (:frame-id rect)))))
+
+(t/deftest group-of-container-derives-bounds
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/group {}
+                                                 (builder/group {}
+                                                                (builder/rect {:x 5 :y 5 :width 10 :height 10}))))
+        outer    (first (children-of instance uuid/zero))
+        inner    (first (children-of instance (:id outer)))]
+    (t/is (= [5 5 10 10]
+             [(:x outer) (:y outer) (:width outer) (:height outer)]))
+    (t/is (= [5 5 10 10]
+             [(:x inner) (:y inner) (:width inner) (:height inner)]))
+    (t/is (= 1 (count (child-ids instance (:id outer)))))))
+
+(t/deftest empty-frame-is-allowed
+  (let [instance (builder/fixture {:seed 1}
+                                  (builder/frame {:x 0 :y 0 :width 10 :height 10}))
+        frame    (first (children-of instance uuid/zero))]
+    (t/is (= [] (child-ids instance (:id frame))))))
+
+(t/deftest caught-empty-group-still-fails-finish
+  (let [state (run-scope {:seed 1}
+                         (fn []
+                           (try
+                             (builder/group {})
+                             (catch :default _ nil))))]
+    (t/is (= ::builder/unfinished-container
+             (:type (failure-data #(builder/finish! state)))))))
+
+(t/deftest container-failure-restores-parent-and-marks-unfinished
+  (let [state (run-scope {:seed 1}
+                         (fn []
+                           (builder/rect {:x 0})
+                           (try
+                             (builder/frame {:x 0 :y 0 :width 10 :height 10}
+                                            (builder/rect :dup {:x 1})
+                                            (builder/rect :dup {:x 2}))
+                             (catch :default _ nil))
+                           (builder/rect {:x 3})))
+        root-children (child-ids @state uuid/zero)
+        last-child    (get-in @state [:objects (last root-children)])]
+    (t/is (= 3 (count root-children)))
+    (t/is (= :rect (:type last-child)))
+    (t/is (= 3 (:x last-child)))
+    (t/is (= 1 (count (:unfinished @state))))
+    (t/is (= ::builder/unfinished-container
+             (:type (failure-data #(builder/finish! state)))))))