tool: scenariotest: EDN scenario + play-loop harness

tools/scenarios/water-burning.edn

@@ -0,0 +1,31 @@
+;; Dev scenario: player standing in a shallow-water pool, fire-imp at preferred
+;; range and already hunting. Wait (.) and the imp should shoot.
+;;
+;; Pool (`@` is the player):
+;;   @~
+;;   ~~
+;;
+;; On main (#162): water becomes fire and the player catches :burning.
+;; With fix/water-burning: water stays water and burning is refused.
+;;
+;;   lg tools/scenariotest.lg tools/scenarios/water-burning.edn
+{:name "water-burning"
+ :desc "Wait for the fire-imp to shoot. You are in water — you should not burn (#162)."
+ :w 16
+ :h 10
+ :seed 42
+ :fill 1
+ :paint [[5 4 3] [6 4 3]
+         [5 5 3] [6 5 3]] ; 2x2 shallow-water pool; player on top-left
+ :player {:pos [5 4]
+          ;; Survive several double-shots (imp speed 2) so the status is visible.
+          :body {:hp 80 :max-hp 80}}
+ :creatures [{:species :fire-imp
+              :pos [9 4]   ; chebyshev dist 4 — in preferred range, not too-close
+              :ai {:state :hunt}
+              ;; Make the shot reliable for review; production chance is 60% /
+              ;; accuracy 75%. Force both so a few waits always land the hit.
+              :merge {:spells {:ranged {:damage 3 :range 5
+                                        :fire-chance 100 :accuracy 100}}}}]
+ :gear? false
+ :log ["scenariotest: water-burning — stand still (.) and watch the imp shot (#162)"]}

tools/scenarios/web-trample.edn

@@ -0,0 +1,27 @@
+;; Dev scenario: player starts webbed on an intact web with two struggles left.
+;; Press up-left (y/7) twice.
+;;
+;; Web patch (`@` is the player on the center web):
+;;    ::
+;;   :@:
+;;    ::
+;;
+;; On main (#161): the first struggle's generic status tick silently removes
+;; :webbed, then the second press moves the player off the still-intact web.
+;; With fix/web-trample (#166): the first press leaves one struggle; the second
+;; tears the player free and tramples the web to ash without moving.
+;;
+;;   lg tools/scenariotest.lg tools/scenarios/web-trample.edn
+{:name "web-trample"
+ :desc "Press up-left twice. Breaking free should trample the web to ash (#161 / #166)."
+ :w 16
+ :h 10
+ :seed 161
+ :fill 1
+ :paint [[5 3 19] [6 3 19]
+         [4 4 19] [5 4 19] [6 4 19]
+         [5 5 19] [6 5 19]] ; 2/3/2 web patch; player on center tile
+ :player {:pos [5 4]
+          :statuses {:webbed {:ttl 2 :max-ttl 2}}}
+ :gear? false
+ :log ["scenariotest: web-trample — press up-left twice (y/7) and inspect the web"]}

tools/scenariotest.lg

@@ -0,0 +1,139 @@
+(ns scenariotest
+  "Dev-scoped scenario → play-loop harness.
+
+   Loads a handcrafted EDN arena (see tools/scenarios/), builds a real xsofy
+   world (no dungeon gen), and drives it through xsofy.play/run-play-loop —
+   the same dispatch / update-world / render path as the game. Use this to
+   interactively review interaction bugs (water+burning, webs, …) without
+   hunting for the right seed in a full dungeon.
+
+   Run (needs a TTY, except --check):
+     lg tools/scenariotest.lg tools/scenarios/water-burning.edn
+     lg tools/scenariotest.lg tools/scenarios/web-trample.edn
+     lg tools/scenariotest.lg --check tools/scenarios/water-burning.edn
+     lg tools/scenariotest.lg --check tools/scenarios/web-trample.edn
+
+   Default scenario when no path is given: tools/scenarios/water-burning.edn
+
+   In-game keys are the normal ones (. wait, hjkl/arrows move, Esc/Ctrl-C quit).
+   Unhandled menu screens are dismissed so the draft stays focused on the
+   arena; open a follow-up if inventory/help need full loops here.
+
+   Sibling of tools/lighttest.lg (interactive, isolated), but lighttest stops
+   at terrain/lighting — this one boots the real play loop on purpose."
+  (:require [term]
+            [os]
+            [tools.scenariotest.build :as build]
+            [xsofy.play :as play]
+            [xsofy.render :as render]
+            [xsofy.world :as world]))
+
+(def default-scenario "tools/scenarios/water-burning.edn")
+
+;; --- terminal lifecycle (mirrors lighttest / main) ---
+
+(defn- init-terminal []
+  (when (nil? (term/size))
+    (println "scenariotest needs a real terminal — run it natively with lg tools/scenariotest.lg.")
+    (os/exit 1))
+  (term/raw-mode!)
+  (term/alternate-screen)
+  (term/hide-cursor)
+  (term/clear))
+
+(defn- shutdown-terminal []
+  (term/reset-style)
+  (term/show-cursor)
+  (term/main-screen)
+  (term/flush)
+  (term/restore-mode!))
+
+(defn- read-key! []
+  (term/read-key))
+
+;; --- thin screen handling (play-loop returns when :screen is set) ---
+
+(defn- handle-hazard [world]
+  (render/render-full world)
+  (let [prompt (or (:hazard-prompt world) "Are you sure?")
+        _ (render/render-hazard-prompt world prompt)
+        k (read-key!)]
+    (if (= k "y")
+      (world/confirm-hazard-step world)
+      (world/cancel-hazard-step world))))
+
+(defn- handle-quit [world]
+  (render/render-full world)
+  (render/render-hazard-prompt world "Leave scenariotest?")
+  (if (= (read-key!) "y")
+    (assoc world :running false)
+    (dissoc world :screen)))
+
+(defn- dismiss-screen [world]
+  "Draft stub: drop unsupported menus and keep playing the arena."
+  (let [scr (or (:screen world) :unknown)]
+    (-> world
+        (dissoc :screen)
+        (world/log-msg (str "scenariotest: dismissed :" (name scr)
+                            " (not wired in this draft)")))))
+
+(defn- step-screens [world]
+  (case (:screen world)
+    nil world
+    :confirm-hazard (handle-hazard world)
+    :confirm-quit   (handle-quit world)
+    ;; A dead arena cannot resume: dismissing :death just makes update-world
+    ;; reopen it after the next action, trapping the harness in a loop.
+    :death          (assoc world :running false)
+    ;; title/inventory/help/console/… — out of scope for the draft
+    (dismiss-screen world)))
+
+(defn- run-play [world]
+  (init-terminal)
+  (try
+    (render/render-full world)
+    (loop [world world
+           prev-size (term/size)]
+      (cond
+        (not (:running world)) world
+
+        (:screen world)
+        (let [w (step-screens world)]
+          (when (:running w)
+            (render/render-full w))
+          (recur w (term/size)))
+
+        :else
+        (let [result (play/run-play-loop world prev-size)]
+          (recur result (term/size)))))
+    (finally
+      (shutdown-terminal))))
+
+;; --- CLI ---
+
+(defn- parse-args [args]
+  (let [args (vec (or args []))]
+    (cond
+      (empty? args)
+      {:check? false :scenario-arg default-scenario}
+
+      (= (first args) "--check")
+      {:check? true :scenario-arg (or (second args) default-scenario)}
+
+      :else
+      {:check? false :scenario-arg (first args)})))
+
+(defn -main []
+  (let [{:keys [check? scenario-arg]} (parse-args *command-line-args*)
+        scenario (build/load-scenario scenario-arg)
+        world (build/build-world scenario)
+        summary (build/summarize world scenario)]
+    (println summary)
+    (if check?
+      (do (println "scenariotest --check ok")
+          (os/exit 0))
+      (do (run-play world)
+          (println "scenariotest done.")))))
+
+(when-not *compiling-aot*
+  (-main))

tools/scenariotest/build.lg

@@ -0,0 +1,131 @@
+(ns tools.scenariotest.build
+  "Build a playable xsofy world from a dev-scoped scenario EDN map.
+
+   Scenarios are handcrafted arenas — not dungeon gen. The shape is intentionally
+   small so a reviewer can stage one interaction (water+imp, web+struggle, …)
+   and drive it through the real play/dispatch loop.
+
+   Keys (all optional unless noted):
+     :name       string label
+     :desc       string logged on boot
+     :w :h       arena size (default 16×10)
+     :seed       gameplay seed (default 1)
+     :depth      floor depth (default 1)
+     :fill       interior tile id (default 1 = stone floor)
+     :paint      [[x y tile] ...] overlays after fill+border
+     :player     {:pos [x y] :statuses {...}}
+     :creatures  [{:species :fire-imp :pos [x y] :ai {...} :merge {...}} ...]
+     :gear?      true → give-starting-items (default false)
+     :log        initial message-log lines
+
+   The border is always stone walls (tile 8). Creatures are spawned via
+   ent/spawn then optionally :ai-merged / deep-merged so a scenario can wake
+   an AI or force a 100% fire-chance without forking the bestiary."
+  (:require [xsofy.terrain :as terrain]
+            [xsofy.entities :as ent]
+            [xsofy.world :as world]))
+
+(def defaults
+  {:w 16 :h 10 :seed 1 :depth 1 :fill 1 :gear? false
+   :paint [] :creatures [] :log []})
+
+(defn- paint-arena!
+  "Fill interior with :fill, wall the border, then apply :paint overlays."
+  [terrain w h fill paint]
+  (dotimes [y h]
+    (dotimes [x w]
+      (terrain/tset! terrain w x y
+                     (if (or (zero? x) (zero? y)
+                             (= x (dec w)) (= y (dec h)))
+                       8
+                       fill))))
+  (doseq [[x y tile] paint]
+    (when (and (>= x 0) (>= y 0) (< x w) (< y h))
+      (terrain/tset! terrain w x y tile)))
+  terrain)
+
+(defn- spawn-creature
+  "Spawn one creature and apply optional :ai / :merge patches."
+  [world {:keys [species pos ai] :as spec}]
+  (when (nil? species)
+    (throw "scenariotest: creature entry needs :species"))
+  (when (nil? pos)
+    (throw (str "scenariotest: creature " species " needs :pos")))
+  (let [before-ids (set (keys (:entities world)))
+        w (ent/spawn world species pos)
+        id (first (filter (fn [id] (not (contains? before-ids id)))
+                          (keys (:entities w))))]
+    (when (nil? id)
+      (throw (str "scenariotest: spawn of " species " at " pos " produced no creature")))
+    (cond-> w
+      ai (update-in [:entities id :ai] merge ai)
+      (:merge spec) (update-in [:entities id] ent/deep-merge (:merge spec)))))
+
+(defn build-world
+  "Turn a scenario map into a world ready for play/run-play-loop."
+  [scenario]
+  (let [sc (merge defaults scenario)
+        {:keys [w h seed depth fill paint creatures gear?]} sc
+        player-spec (or (:player sc) {})
+        ppos (or (:pos player-spec) [(quot w 2) (quot h 2)])
+        terrain (paint-arena! (terrain/make-terrain w h) w h fill (or paint []))
+        player (-> (world/make-player)
+                   (assoc :pos ppos)
+                   (cond-> (:statuses player-spec)
+                     (assoc :statuses (:statuses player-spec)))
+                   (cond-> (:body player-spec)
+                     (update :body merge (:body player-spec))))
+        boot-log (vec (concat
+                        [(str "scenariotest: " (or (:name sc) "scenario"))]
+                        (or (:log sc) [])
+                        (when (:desc sc) [(:desc sc)])))
+        base {:terrain terrain
+              :width w
+              :height h
+              :entities {:player player}
+              :fov #{}
+              :memory {}
+              :lights nil
+              :stains {}
+              :gases {}
+              :fire-ttl {}
+              :log boot-log
+              :turn 0
+              :depth depth
+              :floors {}
+              :gold 0
+              :rune-table {}
+              :running true
+              :seed seed
+              :seed-input seed
+              :action-log []}
+        w0 (reduce spawn-creature base creatures)
+        w1 (if gear? (world/give-starting-items w0) w0)]
+    (world/update-fov w1)))
+
+(defn load-scenario
+  "Parse scenario from an inline EDN map string, a file path, or a map."
+  [arg]
+  (cond
+    (map? arg) arg
+    (or (nil? arg) (= arg ""))
+    (throw "scenariotest: pass a scenario path or inline EDN map")
+    (= \{ (first arg)) (read-string arg)
+    :else (read-string (slurp arg))))
+
+(defn summarize
+  "One-line human summary for --check / boot banner."
+  [world scenario]
+  (let [p (get-in world [:entities :player])
+        [px py] (:pos p)
+        tile (terrain/tget (:terrain world) (:width world) px py)
+        creatures (->> (vals (:entities world))
+                       (filter (fn [e] (and (:ai e) (not= :player (:id e)))))
+                       (map (fn [e] (str (name (:template e)) "@" (:pos e))))
+                       (vec))]
+    (str (or (:name scenario) "?")
+         " " (:width world) "x" (:height world)
+         " player@" [px py] " tile=" tile
+         " fov=" (count (or (:fov world) #{}))
+         (when (seq creatures)
+           (str " creatures=" creatures)))))

xsofy/test/run.lg

@@ -20,6 +20,7 @@
             [xsofy.test.replay-test]
             [xsofy.test.ui-test]
             [xsofy.test.play-test]
+            [xsofy.test.scenariotest-test]
             [xsofy.test.menu-dispatch-test]
             [xsofy.test.input-test]
             [xsofy.test.console-test]))

xsofy/test/scenariotest_test.lg

@@ -0,0 +1,53 @@
+(ns xsofy.test.scenariotest-test
+  (:require [test :refer [deftest is testing]]
+            [tools.scenariotest.build :as build]
+            [xsofy.terrain :as terrain]))
+
+(deftest creature-patches-target-the-newly-spawned-entity
+  (testing "an overlapping player is not mistaken for the spawned creature"
+    (let [w (build/build-world
+              {:w 8 :h 8 :seed 1
+               :player {:pos [3 3]}
+               :creatures [{:species :fire-imp
+                            :pos [3 3]
+                            :ai {:state :hunt}
+                            :merge {:body {:hp 99}}}]})
+          player (get-in w [:entities :player])
+          imp (first (filter (fn [e] (= :fire-imp (:template e)))
+                             (vals (:entities w))))]
+      (is (not= :hunt (get-in player [:ai :state]))
+          "the player did not receive the creature's AI patch")
+      (is (some? imp) "the requested creature was spawned")
+      (is (= :hunt (get-in imp [:ai :state]))
+          "the spawned creature received the AI patch")
+      (is (= 99 (get-in imp [:body :hp]))
+          "the spawned creature received the deep merge patch"))))
+
+(deftest bundled-web-trample-scenario-stages-issue-161
+  (testing "the web scenario starts in a 2/3/2 patch with two struggles left"
+    (let [scenario (build/load-scenario "tools/scenarios/web-trample.edn")
+          w (build/build-world scenario)
+          [px py] (get-in w [:entities :player :pos])
+          web-pos [[5 3] [6 3]
+                   [4 4] [5 4] [6 4]
+                   [5 5] [6 5]]]
+      (is (= "web-trample" (:name scenario)))
+      (is (= [5 4] [px py]))
+      (is (every? (fn [[x y]]
+                    (= 19 (terrain/tget (:terrain w) (:width w) x y)))
+                  web-pos)
+          "the full 2/3/2 patch is intact")
+      (is (= 2 (get-in w [:entities :player :statuses :webbed :ttl]))
+          "two movement attempts are required to break free"))))
+
+(deftest bundled-water-burning-scenario-stages-issue-162
+  (testing "the water scenario starts in a 2x2 shallow-water pool"
+    (let [scenario (build/load-scenario "tools/scenarios/water-burning.edn")
+          w (build/build-world scenario)
+          water-pos [[5 4] [6 4] [5 5] [6 5]]]
+      (is (= "water-burning" (:name scenario)))
+      (is (= [5 4] (get-in w [:entities :player :pos])))
+      (is (every? (fn [[x y]]
+                    (= 3 (terrain/tget (:terrain w) (:width w) x y)))
+                  water-pos)
+          "the full 2x2 pool is shallow water"))))