🚧 WIP Step 3, fixture macros, prng, defaults, placeholder scene

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

@@ -0,0 +1,70 @@
+;; 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 benches.render-wasm.scenes.builder
+  "Construction macros for renderer benchmark fixtures.
+
+  Runtime helpers and scope state live in the sibling `builder.cljs`.
+
+  Usage:
+
+    (fixture {:seed 42
+              :defaults {:rect {:x (gen-int 0 1920)}}}
+      (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
+
+  `params` is a map with `:seed` (required), optional `:root` attributes for
+  the canonical root frame, and optional `:defaults` with one attribute
+  generator map per shape type.
+
+  Consumers require this namespace with `:include-macros true` (or
+  `:require-macros`) to use the macros; the runtime helpers live under the
+  same alias.
+
+  The scope is carried by the dynamic `*state*`, so ordinary `let`, `doseq`
+  and functions defined outside the scope work inside the body. Scopes
+  cannot nest and a body exception unwinds without leaking state.")
+
+(defmacro fixture
+  "Runs `body` in a fixture scope and returns the validated snapshot."
+  [params & body]
+  `(let [params# ~params
+         state#  (benches.render-wasm.scenes.builder/start params#)]
+     (binding [benches.render-wasm.scenes.builder/*state* state#
+               benches.render-wasm.scenes.builder/*defaults* (:defaults params#)]
+       ~@body
+       (benches.render-wasm.scenes.builder/finish! state#))))
+
+(defmacro rect
+  "Adds one rectangle to the current fixture scope and returns its uuid.
+
+  Forms: `(rect)`, `(rect attrs)`, `(rect label)`, `(rect label attrs)`.
+  A one-argument call is resolved at runtime: a map is `attrs`, anything
+  else is a label. `label` must be a keyword or vector, stored in the
+  instance `:refs`; duplicates and other label types are rejected. `attrs`
+  override the generated defaults attribute by attribute."
+  ([]
+   `(benches.render-wasm.scenes.builder/rect!
+     benches.render-wasm.scenes.builder/*state*
+     benches.render-wasm.scenes.builder/*defaults*
+     nil
+     {}))
+
+  ([label-or-attrs]
+   `(benches.render-wasm.scenes.builder/rect!
+     benches.render-wasm.scenes.builder/*state*
+     benches.render-wasm.scenes.builder/*defaults*
+     ~label-or-attrs
+     {}))
+
+  ([label attrs]
+   `(benches.render-wasm.scenes.builder/rect!
+     benches.render-wasm.scenes.builder/*state*
+     benches.render-wasm.scenes.builder/*defaults*
+     ~label
+     ~attrs)))

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

@@ -0,0 +1,240 @@
+;; 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 benches.render-wasm.scenes.builder
+  "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.
+
+  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.
+
+  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."
+  (:require
+   [app.common.types.color :as clr]
+   [app.common.types.shape :as cts]
+   [app.common.uuid :as uuid]
+   [benches.render-wasm.scenes.common :as sc]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Poor-man's seeded PRNG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; WTF? clj has no seedable PRNG!? `rand`/`rand-int` call Math.random which is
+;; unseeded. I can't find any RNG wich takes a seed among the deps.
+;; We implement mulberry32 here instead.
+(defn- make-random
+  "Returns a zero-arg function that draws a float in `[0, 1)` from the seeded.
+
+  This is Mulberry32 which reportedly misses about 1/3 of the range. Do NOT USE
+  for anything requiring actual random numbers!
+  "
+  [seed]
+  (let [state (atom (bit-or seed 0))]
+    (fn []
+      (let [s (swap! state (fn [s] (bit-or (+ s 0x6d2b79f5) 0)))
+            v (js/Math.imul (bit-xor s (unsigned-bit-shift-right s 15))
+                            (bit-or s 1))
+            v (bit-xor v (+ v (js/Math.imul (bit-xor v (unsigned-bit-shift-right v 7))
+                                            (bit-or v 61))))
+            v (bit-xor v (unsigned-bit-shift-right v 14))]
+        (/ (unsigned-bit-shift-right v 0) 4294967296)))))
+
+(defn rng-float
+  "Draws a float in `[min, max)` from the scope random source."
+  [rng min max]
+  (+ min (* (rng) (- max min))))
+
+(defn rng-int
+  "Draws an integer in `[min, max)` from the scope random source."
+  [rng min max]
+  (js/Math.floor (rng-float rng min max)))
+
+(defn- round3
+  [value]
+  (/ (js/Math.round (* 1000 value)) 1000))
+
+(defn rng-uuid
+  "Draws a deterministic uuid from two 32-bit values of the random source."
+  [rng]
+  (uuid/custom (rng-int rng 0 4294967296)
+               (rng-int rng 0 4294967296)))
+
+(defn- random-hex-color
+  [rng]
+  (clr/rgb->hex [(rng-int rng 0 256) (rng-int rng 0 256) (rng-int rng 0 256)]))
+
+(defn- random-opacity
+  [rng]
+  (min 0.999 (round3 (rng-float rng 0.1 1))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Attribute generators
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn gen-int
+  "Integer generator over `[min, max)`."
+  [min max]
+  (fn [rng] (rng-int rng min max)))
+
+(defn gen-float
+  "Float generator rounded to three decimals so snapshots stay readable."
+  [min max]
+  (fn [rng] (round3 (rng-float rng min max))))
+
+(defn gen-hex-color
+  "Generator of a random `#rrggbb` string."
+  []
+  (fn [rng] (random-hex-color rng)))
+
+(defn gen-one-of
+  "Generator that picks one value per draw. Rejects an empty collection."
+  [values]
+  (when (empty? values)
+    (throw (ex-info "gen-one-of requires at least one value"
+                    {:type ::no-values})))
+  (fn [rng] (nth values (rng-int rng 0 (count values)))))
+
+(defn gen-fill
+  "Generator of one translucent solid fill."
+  []
+  (fn [rng]
+    {:fill-color (random-hex-color rng)
+     :fill-opacity (random-opacity rng)}))
+
+(defn gen-stroke
+  "Centered stroke like the interim rectangle workload."
+  [width]
+  (fn [rng]
+    {:stroke-width width
+     :stroke-alignment :center
+     :stroke-color (random-hex-color rng)
+     :stroke-opacity (random-opacity rng)}))
+
+(defn gen-vector
+  "Composes generators into a generator of a vector, one value per
+  generator."
+  [& generators]
+  (fn [rng] (mapv #(% rng) generators)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Scope state
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:dynamic *state*
+  "Current fixture scope; bound by the `fixture` macro."
+  nil)
+
+(def ^:dynamic *defaults*
+  "Per-shape-type attribute generator maps bound by the `fixture` macro,
+  e.g. `{:rect {:x (gen-int 0 1920) ...}}`. Values are literals or one-arg
+  functions of the scope random source."
+  {})
+
+(defn- ensure-state
+  [state]
+  (or state
+      (throw (ex-info "rect used outside a fixture scope"
+                      {:type ::outside-scope}))))
+
+(defn- check-seed!
+  [seed]
+  (when-not (and (integer? seed) (<= 0 seed) (< seed 4294967296))
+    (throw (ex-info "fixture scope requires an integer :seed in [0, 2^32)"
+                    {:type ::invalid-seed
+                     :seed seed}))))
+
+(defn start
+  "Starts a fixture scope. Returns the scope state atom."
+  [params]
+  (when (some? *state*)
+    (throw (ex-info "fixture scopes cannot nest"
+                    {:type ::nested-scope})))
+  (check-seed! (:seed params))
+  (let [seed (:seed params)
+        root (cts/setup-shape (merge (:root params)
+                                     {:id uuid/zero
+                                      :type :frame
+                                      :name "Root Frame"
+                                      :parent-id uuid/zero
+                                      :frame-id uuid/zero
+                                      :shapes []}))]
+    (atom {:seed seed
+           :rng (make-random seed)
+           :objects {uuid/zero root}
+           :refs {}})))
+
+(defn- resolve-attr
+  [rng spec]
+  (if (fn? spec) (spec rng) spec))
+
+(defn- resolve-attrs
+  [rng defaults attrs]
+  (merge (reduce-kv (fn [result key spec]
+                      (assoc result key (resolve-attr rng spec)))
+                    {}
+                    defaults)
+         attrs))
+
+(defn- register-ref!
+  [state label id]
+  (when (some? label)
+    (when (contains? (:refs @state) label)
+      (throw (ex-info (str "duplicate fixture label: " label)
+                      {:type ::duplicate-label
+                       :label label})))
+    (swap! state assoc-in [:refs label] id)))
+
+(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
+  vectors."
+  [label attrs]
+  (cond
+    (and (map? label) (empty? attrs)) [nil label]
+    (nil? label) [nil attrs]
+    (or (keyword? label) (vector? label)) [label attrs]
+    :else (throw (ex-info "rect label must be a keyword or vector"
+                          {:type ::invalid-label
+                           :label label}))))
+
+(defn rect!
+  "Adds one rectangle to the scope and returns its uuid. This is the primitive
+  behind the `rect` macro."
+  [state defaults label attrs]
+  (let [state         (ensure-state state)
+        [label attrs] (normalize-label-and-attrs label attrs)
+        rng           (:rng @state)
+        attrs         (resolve-attrs rng (:rect defaults) attrs)
+        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))))
+    id))
+
+(defn finish!
+  "Validates the scope snapshot and returns it."
+  [state]
+  (let [instance {:objects (:objects @state)
+                  :refs (:refs @state)}]
+    (sc/validate! instance)
+    instance))

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

@@ -0,0 +1,50 @@
+;; 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 benches.render-wasm.scenes.rects
+  "Rectangle fixture, the smallest benchmark workload.
+
+  Distributes rectangles over the canvas with varied sizes, translucent
+  fills and centered strokes, all drawn from the scope's seeded generator.
+  Ticket20 wraps `build` with case declarations; the path and effect
+  fixtures arrive in tickets07/08."
+  (:require
+   [benches.render-wasm.scenes.builder :as sb :include-macros true]))
+
+(def default-params
+  {:count 1000
+   :width 1920
+   :height 1080
+   :min-size 20
+   :max-size 100})
+
+(defn rect-defaults
+  "Attribute generators for one rectangle of the workload."
+  [{:keys [width height min-size max-size]}]
+  {:x       (sb/gen-int 0 width)
+   :y       (sb/gen-int 0 height)
+   :width   (sb/gen-int min-size max-size)
+   :height  (sb/gen-int min-size max-size)
+   :fills   (sb/gen-vector (sb/gen-fill))
+   :strokes (sb/gen-vector (sb/gen-stroke 10))
+   :r1      (sb/gen-int 0 24)
+   :r2      (sb/gen-int 0 24)
+   :r3      (sb/gen-int 0 24)
+   :r4      (sb/gen-int 0 24)})
+
+(defn build
+  "Builds the seeded rectangle fixture. `params` requires `:seed`; the other
+  keys default to `default-params`."
+  [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)))))

frontend/test/frontend_tests/benches/builder_test.cljs

@@ -0,0 +1,211 @@
+;; 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.builder-test
+  (:require
+   [app.common.uuid :as uuid]
+   [benches.render-wasm.scenes.builder :as b :include-macros true]
+   [benches.render-wasm.scenes.common :as common]
+   [benches.render-wasm.scenes.rects :as rects]
+   [cljs.test :as t :include-macros true]))
+
+(defn- build
+  ([] (build {}))
+  ([params] (rects/build (merge {:seed 42 :count 5} params))))
+
+(defn- rect-shapes
+  "Rectangles of a fixture instance in creation order."
+  [instance]
+  (mapv (:objects instance)
+        (get-in instance [:objects uuid/zero :shapes])))
+
+(defn- failure-data
+  [f]
+  (try
+    (f)
+    nil
+    (catch :default cause
+      (ex-data cause))))
+
+(defn- add-tile
+  "Helper defined outside a fixture scope, called from inside one."
+  [index]
+  (b/rect [:tile index] {:x (* 10 index)}))
+
+(t/deftest repeatable-builds-are-identical
+  (t/is (= (build) (build)))
+  (t/is (not= (build) (build {:seed 43}))))
+
+(t/deftest rectangle-workload-keeps-default-count
+  (let [instance (rects/build {:seed 42})
+        rects    (rect-shapes instance)]
+    (t/is (= 1000 (:count rects/default-params)))
+    (t/is (= 1000 (count rects)))
+    (t/is (< 1 (count (distinct (map :x rects)))))))
+
+(t/deftest default-workload-is-canonical
+  (let [instance (build {:count 25})
+        rects    (rect-shapes instance)]
+    (t/is (= 25 (count rects)))
+    (t/is (every? #(= :rect (:type %)) rects))
+    (t/is (every? (fn [rect]
+                    (and (= 1 (count (:fills rect)))
+                         (= 1 (count (:strokes rect)))
+                         (= 10 (:stroke-width (first (:strokes rect))))
+                         (= :center (:stroke-alignment (first (:strokes rect))))))
+                  rects))
+    (t/is (every? (fn [rect]
+                    (and (re-matches #"^#[0-9a-f]{6}$" (:fill-color (first (:fills rect))))
+                         (<= 0.1 (:fill-opacity (first (:fills rect))) 0.999)
+                         (every? #(<= 0 % 24) [(:r1 rect) (:r2 rect) (:r3 rect) (:r4 rect)])))
+                  rects))))
+
+(t/deftest geometry-is-page-relative-and-in-range
+  (let [params   {:seed 7 :count 40 :width 800 :height 600 :min-size 5 :max-size 15}
+        instance (build params)
+        rects    (rect-shapes instance)]
+    (t/is (every? #(<= 0 (:x %) 800) rects))
+    (t/is (every? #(<= 0 (:y %) 600) rects))
+    (t/is (every? #(<= 5 (:width %) 15) rects))
+    (t/is (every? #(<= 5 (:height %) 15) rects))
+    (t/is (= 800 (get-in instance [:objects uuid/zero :width])))
+    (t/is (= 600 (get-in instance [:objects uuid/zero :height])))))
+
+(t/deftest labels-are-instance-local
+  (let [instance (b/fixture {:seed 1}
+                            (b/rect)
+                            (b/rect :hero {})
+                            (b/rect [:tile 1] {}))
+        refs     (:refs instance)
+        children (get-in instance [:objects uuid/zero :shapes])]
+    (t/is (= #{:hero [:tile 1]} (set (keys refs))))
+    (t/is (= (get refs :hero) (second children)))
+    (t/is (= (get refs [:tile 1]) (nth children 2)))))
+
+(t/deftest attrs-override-generated-values
+  (let [instance (b/fixture {:seed 1
+                             :defaults {:rect {:x (b/gen-int 0 100)}}}
+                            (b/rect {:x 7 :fills []}))
+        rect     (first (rect-shapes instance))]
+    (t/is (= 7 (:x rect)))
+    (t/is (= [] (:fills rect)))))
+
+(t/deftest ordinary-forms-work-inside-the-scope
+  (let [instance (b/fixture {:seed 1}
+                            (let [first-id (b/rect)]
+                              (t/is (uuid? first-id)))
+                            (doseq [index (range 3)]
+                              (add-tile index))
+                            (b/rect :last {:x 99}))
+        refs     (:refs instance)
+        rects    (rect-shapes instance)]
+    (t/is (= 5 (count rects)))
+    (t/is (= [0 10 20]
+             (mapv #(:x (get-in instance [:objects (get refs [:tile %])]))
+                   (range 3))))
+    (t/is (= 99 (:x (get-in instance [:objects (get refs :last)]))))))
+
+(t/deftest duplicate-labels-are-rejected
+  (let [data (failure-data
+              #(b/fixture {:seed 1}
+                          (b/rect :dup {})
+                          (b/rect :dup {})))]
+    (t/is (= ::b/duplicate-label (:type data)))
+    (t/is (= :dup (:label data)))))
+
+(t/deftest failed-builds-leak-no-state
+  (let [clean (build)]
+    (failure-data #(b/fixture {:seed 99}
+                              (b/rect :dup {})
+                              (b/rect :dup {})))
+    (t/is (= clean (build)))))
+
+(t/deftest rect-outside-scope-is-rejected
+  (let [data (failure-data #(b/rect))]
+    (t/is (= ::b/outside-scope (:type data)))))
+
+(t/deftest nested-scopes-are-rejected
+  (let [data (failure-data
+              #(b/fixture {:seed 1}
+                          (b/fixture {:seed 2}
+                                     (b/rect))))]
+    (t/is (= ::b/nested-scope (:type data)))))
+
+(t/deftest invalid-seeds-are-rejected
+  (t/is (= ::b/invalid-seed
+           (:type (failure-data #(b/fixture {} (b/rect))))))
+  (t/is (= ::b/invalid-seed
+           (:type (failure-data #(b/fixture {:seed -1} (b/rect))))))
+  (t/is (= ::b/invalid-seed
+           (:type (failure-data #(b/fixture {:seed 4294967296} (b/rect)))))))
+
+(t/deftest runtime-attrs-maps-are-resolved
+  (let [attrs    {:x 11}
+        instance (b/fixture {:seed 1}
+                            (b/rect attrs))
+        rect     (first (rect-shapes instance))]
+    (t/is (= 11 (:x rect)))))
+
+(t/deftest single-label-form-is-supported
+  (let [instance (b/fixture {:seed 1}
+                            (b/rect :solo))
+        id       (get (:refs instance) :solo)]
+    (t/is (uuid? id))
+    (t/is (= [id] (get-in instance [:objects uuid/zero :shapes])))))
+
+(t/deftest built-instance-feeds-the-snapshot-api
+  (let [instance (b/fixture {:seed 1}
+                            (b/rect :hero {}))
+        order    (common/upload-order instance)
+        hero-id  (common/ref-id instance :hero)]
+    (t/is (= [uuid/zero hero-id] (mapv :id order)))))
+
+(t/deftest invalid-labels-are-rejected
+  (let [data (failure-data #(b/fixture {:seed 1} (b/rect "hero" {})))]
+    (t/is (= ::b/invalid-label (:type data)))))
+
+(t/deftest protected-keys-cannot-be-overridden
+  (let [other    (uuid/custom 9 9)
+        instance (b/fixture {:seed 1}
+                            (b/rect {:type :circle :id other :parent-id other}))
+        rect     (first (rect-shapes instance))]
+    (t/is (= :rect (:type rect)))
+    (t/is (not= other (:id rect)))
+    (t/is (= uuid/zero (:parent-id rect)))))
+
+(t/deftest root-protected-keys-cannot-be-overridden
+  (let [other    (uuid/custom 9 8)
+        instance (b/fixture {:seed 1
+                             :root {:id other :type :rect :width 10}}
+                            (b/rect))
+        root     (get-in instance [:objects uuid/zero])]
+    (t/is (= uuid/zero (:id root)))
+    (t/is (= :frame (:type root)))
+    (t/is (= 10 (:width root)))))
+
+(t/deftest attrs-override-generated-fills
+  (let [fill     {:fill-color "#ffffff" :fill-opacity 1}
+        instance (b/fixture {:seed 1}
+                            (b/rect {:fills [fill]}))
+        rect     (first (rect-shapes instance))]
+    (t/is (= [fill] (:fills rect)))))
+
+(t/deftest generator-helpers-produce-expected-values
+  (let [instance (b/fixture {:seed 3
+                             :defaults {:rect {:opacity (b/gen-float 0.5 0.6)
+                                               :x (b/gen-one-of [4 5])
+                                               :r1 (b/gen-int 3 4)
+                                               :fills (b/gen-vector (b/gen-fill))}}}
+                            (b/rect))
+        rect     (first (rect-shapes instance))]
+    (t/is (<= 0.5 (:opacity rect) 0.6))
+    (t/is (contains? #{4 5} (:x rect)))
+    (t/is (= 3 (:r1 rect)))
+    (t/is (re-matches #"^#[0-9a-f]{6}$" (:fill-color (first (:fills rect)))))))
+
+(t/deftest empty-one-of-is-rejected
+  (let [data (failure-data #(b/gen-one-of []))]
+    (t/is (= ::b/no-values (:type data)))))