peer-kit / src / ardegazu / peer / games / host / valley_blocks_sim.cljs
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
;; ported-from: src/games/host/valley-blocks-sim.ts @ v1.3.0
;;   (itself: game2/client/src/game/party.ts host referee slice: startRound
;;   L502–516, seatedViews/hostEvaluate/evaluate L630–705 @ 25e6d79)
;; divergences: the sim holds NO boards — valley-blocks seats each simulate
;;   their own board from the shared "st" seed and broadcast "bs" states, so
;;   this referee only folds reported BoardStates and calls the verdict; it is
;;   data-driven (verdicts fire from onBoardState/playerLeft, not from a
;;   scheduled step — `next` appears only for the post-round lobby return).
;;   Roster reads / win credits are injected callbacks; the round seed is a
;;   startRound parameter (the browser called randomSeed() in main.ts — the
;;   driver owns that impurity). The <2-player guard ports as written: order is
;;   fixed at round start, leavers stay in the verdict pool as `left`.
;;
;; Pinned by test/vectors/valley-blocks-sim.json: six runs covering all three
;; party modes, the everyone-topped-out highest-score fallback, a leaver who
;; can never win, and the seat-spoof / stale-round refusals.
(ns ardegazu.peer.games.host.valley-blocks-sim
  (:require [ardegazu.peer.games.host.sim :as sim]
            [shadow.cljs.modern :refer (defclass)]))

;; Roundover interstitial before the host returns everyone to the lobby.
(def ROUND-LOBBY-MS 6000)
(def DEFAULT-MODE "race-survival")
(def DEFAULT-TARGET 5000)

;; A SeatView is #js {:state BoardState|nil :over bool :left bool}.

(defclass ValleyBlocksSim
  (constructor [this opts]
    (unchecked-set this "_roster" (unchecked-get opts "roster"))
    (unchecked-set this "_addWin" (unchecked-get opts "addWin"))
    (let [m (unchecked-get opts "mode")
          t (unchecked-get opts "target")]
      (unchecked-set this "_mode" (if ^boolean (js* "~{} == null" m) DEFAULT-MODE m))
      (unchecked-set this "_target"
                     (js/Math.max 100 (bit-or (if ^boolean (js* "~{} == null" t) DEFAULT-TARGET t)
                                              0))))
    (unchecked-set this "_round" 0)
    (unchecked-set this "_order" #js [])
    (unchecked-set this "_views" (js/Map.))
    (unchecked-set this "_running" false)))

(let [proto (.-prototype ValleyBlocksSim)
      getter (fn [name slot]
               (js/Object.defineProperty
                proto name
                #js {:get (fn [] (this-as self (unchecked-get self slot)))
                     :configurable true}))]
  (getter "running" "_running")
  (getter "round" "_round")
  (getter "mode" "_mode")
  (getter "target" "_target"))

(declare verdict)

(defn start-round
  "Deal seats and start a round (ports Party.startRound)."
  [self ids seed]
  (if (or (unchecked-get self "_running") (< (.-length ^js ids) 2))
    sim/NO-EMIT
    (do
      (unchecked-set self "_round" (inc (unchecked-get self "_round")))
      (unchecked-set self "_order" (.slice ^js ids))
      (let [views (js/Map.)]
        (.forEach ^js ids
                  (fn [id] (.set views id (js-obj "state" nil "over" false "left" false))))
        (unchecked-set self "_views" views))
      (unchecked-set self "_running" true)
      (js-obj "frames"
              #js [(sim/frame (js-obj "t" "st"
                                      "round" (unchecked-get self "_round")
                                      "seed" seed
                                      "order" (unchecked-get self "_order")
                                      "mode" (unchecked-get self "_mode")
                                      "target" (unchecked-get self "_target")))]))))

(defn on-board-state
  "Fold one reported board and referee (ports the \"bs\" → hostEvaluate path)."
  [self from round seat s]
  (if (or (not (unchecked-get self "_running"))
          (not (identical? round (unchecked-get self "_round"))))
    sim/NO-EMIT
    (if-not (identical? (aget (unchecked-get self "_order") seat) from)
      sim/NO-EMIT
      (let [v (.get ^js (unchecked-get self "_views") from)]
        (if (or (nil? v) (identical? v js/undefined))
          sim/NO-EMIT
          (do
            (unchecked-set v "state" s)
            (unchecked-set v "over" (unchecked-get s "over"))
            (verdict self)))))))

(defn player-left
  "A seated player left or vanished (ports \"lv\" / peer-gone → hostEvaluate)."
  [self id]
  (let [v (.get ^js (unchecked-get self "_views") id)]
    (if (or (nil? v) (identical? v js/undefined) (unchecked-get v "left"))
      sim/NO-EMIT
      (do
        (unchecked-set v "left" true)
        (unchecked-set v "over" true)
        (if (unchecked-get self "_running") (verdict self) sim/NO-EMIT)))))

(defn snapshot
  "Mid-round context for a late joiner (they spectate until the next round)."
  [self to]
  (if-not (unchecked-get self "_running")
    sim/NO-EMIT
    (js-obj "frames"
            #js [(sim/frame to (js-obj "t" "sn"
                                       "round" (unchecked-get self "_round")
                                       "order" (unchecked-get self "_order")
                                       "mode" (unchecked-get self "_mode")
                                       "target" (unchecked-get self "_target")))])))

(defn abort [self]
  (unchecked-set self "_running" false)
  js/undefined)

(defn- score-of [v]
  (let [s (unchecked-get v "state")]
    (if ^boolean (js* "~{} == null" s) 0 (unchecked-get s "score"))))

(defn- evaluate
  "The verdict rule, verbatim (ports Party.evaluate). Returns
   #js {:winnerId :reason} or nil while the round is undecided."
  [self]
  (let [order (unchecked-get self "_order")
        views (unchecked-get self "_views")
        mode (unchecked-get self "_mode")
        target (unchecked-get self "_target")
        players (.map ^js order (fn [id] (.get ^js views id)))]
    (if (< (.-length players) 2)
      nil
      (let [i (if-not (identical? mode "survival")
                (.findIndex players (fn [p] (and (not (unchecked-get p "left"))
                                                 (>= (score-of p) target))))
                -1)]
        (if (>= i 0)
          (js-obj "winnerId" (aget order i) "reason" "target")
          (let [alive (.filter (.map players (fn [p idx] (js-obj "p" p "i" idx)))
                               (fn [e] (and (not (unchecked-get (unchecked-get e "p") "left"))
                                            (not (unchecked-get (unchecked-get e "p") "over")))))]
            (cond
              (and (not (identical? mode "race")) (identical? 1 (.-length alive)))
              (js-obj "winnerId" (aget order (unchecked-get (aget alive 0) "i"))
                      "reason" "survivor")

              (zero? (.-length alive))
              ;; Everyone is out with no winner: highest score takes it.
              (let [indexed (.map players (fn [p idx] (js-obj "p" p "i" idx)))
                    present (.filter indexed
                                     (fn [e] (not (unchecked-get (unchecked-get e "p") "left"))))
                    pool (if (pos? (.-length present)) present indexed)
                    best (aget (.sort (.slice pool)
                                      (fn [a b] (- (score-of (unchecked-get b "p"))
                                                   (score-of (unchecked-get a "p")))))
                               0)]
                (js-obj "winnerId" (aget order (unchecked-get best "i")) "reason" "score"))

              :else nil)))))))

(defn- verdict [self]
  (let [v (evaluate self)]
    (if (or (nil? v) (identical? v js/undefined))
      sim/NO-EMIT
      (do
        (unchecked-set self "_running" false)
        (let [winner (unchecked-get v "winnerId")]
          (when ^boolean (js* "!!(~{})" winner) ((unchecked-get self "_addWin") winner))
          (let [names (js/Map.)
                order (unchecked-get self "_order")
                views (unchecked-get self "_views")]
            (.forEach ^js ((unchecked-get self "_roster"))
                      (fn [e] (.set names (aget e 0) (aget e 1))))
            (let [seated (.map ^js order
                               (fn [id]
                                 (let [sv (.get ^js views id)
                                       nm (.get names id)]
                                   (js-obj "id" id
                                           "name" (if (identical? nm js/undefined) "???" nm)
                                           "score" (score-of sv)
                                           "out" (or (unchecked-get sv "over")
                                                     (unchecked-get sv "left"))))))
                  standings (.sort (.map seated
                                         (fn [p] #js [(unchecked-get p "id")
                                                      (unchecked-get p "name")
                                                      (unchecked-get p "score")
                                                      (if (unchecked-get p "out") 1 0)]))
                                   (fn [a b] (- (aget b 2) (aget a 2))))]
              (js-obj
               "frames"
               #js [(sim/frame (js-obj "t" "ov"
                                       "round" (unchecked-get self "_round")
                                       "w" winner
                                       "reason" (unchecked-get v "reason")
                                       "standings" standings
                                       "ps" ((unchecked-get self "_roster"))))]
               "matchEnd" (.map seated (fn [p] #js [(unchecked-get p "id")
                                                    (unchecked-get p "name")
                                                    (unchecked-get p "score")]))
               "next" (sim/next-step "lobby" ROUND-LOBBY-MS)))))))))

(let [proto (.-prototype ValleyBlocksSim)]
  (unchecked-set proto "startRound" (fn [ids seed] (this-as self (start-round self ids seed))))
  (unchecked-set proto "onBoardState"
                 (fn [from round seat s] (this-as self (on-board-state self from round seat s))))
  (unchecked-set proto "playerLeft" (fn [id] (this-as self (player-left self id))))
  (unchecked-set proto "snapshot" (fn [to] (this-as self (snapshot self to))))
  (unchecked-set proto "abort" (fn [] (this-as self (abort self)))))

static mirror of HEAD · about · clone: git clone https://git.ardegazu.ro/peer-kit.git