peer-kit / src / ardegazu / peer / games / seance.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
;; ported-from: src/games/seance.ts @ v1.3.0
;;
;; séance (game4) — a haunted-house party game of simultaneous secret room
;; picks. The only turn-based game in the suite, and the friendliest to a bot:
;; each "bell" opens a walk window (durMs + a 500 ms grace), every guest picks
;; one of three rooms (silence = stay), whoever stands in the haunted room loses
;; a candle, last candle standing wins the séance.
;;
;; Client side: send "hi"/"pk" — receive "ro","st","be","hm","pc","rv","ov",
;; "lo","fu","sn" (see game4 client/src/game/protocol.ts). With `host` set the
;; client can claim an empty room and conduct the séance itself.
;;
;; `view()` is field-identical to SeanceGym's views (bell, seat, candles,
;; rooms, hintNot, isMedium — in that order), so a policy trained offline plugs
;; into onTurn unchanged. The order is asserted by the gym view-parity test.
(ns ardegazu.peer.games.seance
  (:require [ardegazu.peer.games.room :as room]
            [ardegazu.peer.games.host.seance-host :as seance-host]
            [shadow.cljs.modern :refer (defclass)]))

(declare wire-seance act)

(defclass SeanceClient
  (extends room/GameRoom)
  (constructor [this peer opts]
    ;; `{ ...opts, hiExtra: () => ({ wins: this.wins }) }`
    (super peer (let [o (js/Object.assign (js-obj) opts)]
                  (unchecked-set o "hiExtra" (fn [] (js-obj "wins" (unchecked-get this "wins"))))
                  o))
    (unchecked-set this "wins" 0)
    (unchecked-set this "_order" #js [])
    (unchecked-set this "_candles" #js [])
    (unchecked-set this "_rooms" #js [])
    (unchecked-set this "_bell" 0)
    (unchecked-set this "_medium" -1)
    (unchecked-set this "_hintNot" -1)
    (unchecked-set this "_onTurn" (unchecked-get opts "onTurn"))
    (unchecked-set this "_actDelayMs" (unchecked-get opts "actDelayMs"))
    (unchecked-set this "_host" nil)
    (let [h (unchecked-get opts "host")]
      (when ^boolean (js* "!!(~{})" h)
        (let [driver (seance-host/SeanceHost. this h)]
          (unchecked-set this "_host" driver)
          (unchecked-set this "hostDriver" driver))))
    (wire-seance this)))

(unchecked-set SeanceClient "joinSeance"
               (fn [opts]
                 (let [o (js/Object.assign (js-obj) opts)]
                   (unchecked-set o "app" "seance")
                   ((unchecked-get SeanceClient "join") o))))

(defn- default-turn
  "Default brain: the medium goes to the room the ghost is NOT in (guaranteed
   safe); everyone else picks at random."
  [v]
  (if (and (unchecked-get v "isMedium") (>= (unchecked-get v "hintNot") 0))
    (unchecked-get v "hintNot")
    (js/Math.floor (* (js/Math.random) 3))))

(defn- seat-of [self]
  (.indexOf ^js (unchecked-get self "_order")
            (unchecked-get (unchecked-get self "peer") "myId")))

(defn- delay-ms [self walk-ms]
  (let [d (unchecked-get self "_actDelayMs")]
    (cond
      (identical? "number" (js* "typeof ~{}" d)) d
      (identical? "function" (js* "typeof ~{}" d)) (d walk-ms)
      ;; humans hesitate: land well inside the window, never after the grace
      :else (js/Math.min (* walk-ms 0.6)
                         (+ 400 (* (js/Math.random)
                                   (js/Math.max 200 (* walk-ms 0.3))))))))

(defn- act [self walk-ms]
  (let [seat (seat-of self)
        candles (unchecked-get self "_candles")]
    (if (or (< seat 0) (<= (let [c (aget candles seat)]
                             (if ^boolean (js* "~{} == null" c) 0 c))
                           0))
      (js/Promise.resolve nil) ; spectating or out
      (let [decide (let [f (unchecked-get self "_onTurn")]
                     (if ^boolean (js* "!!(~{})" f) f default-turn))]
        (-> (js/Promise.resolve nil)
            (.then (fn [_] (decide (.view ^js self))))
            (.then
             (fn [r]
               (when (and (not (nil? r)) (>= r 0) (<= r 2))
                 (let [d (delay-ms self walk-ms)]
                   (if (<= d 0)
                     (.pick ^js self r)
                     (js/setTimeout (fn [] (.pick ^js self r)) d))))
               js/undefined))
            ;; behavior error — stay put, the séance continues
            (.catch (fn [_] nil)))))))

(defn- wire-seance [self]
  (.on ^js self "frame"
       (fn [from m]
         ;; séance frames are host-authoritative
         (when (identical? from (unchecked-get self "hostId"))
           (let [t (unchecked-get m "t")
                 nn (fn [v d] (if ^boolean (js* "~{} == null" v) d v))]
             (cond
               (identical? t "st")
               (let [order (nn (unchecked-get m "order") #js [])
                     candles (nn (unchecked-get m "candles") 3)]
                 (unchecked-set self "_order" order)
                 (unchecked-set self "_candles" (.map ^js order (fn [_] candles)))
                 (unchecked-set self "_rooms" (.map ^js order (fn [_] 0)))
                 (unchecked-set self "_bell" 0)
                 (unchecked-set self "_hintNot" -1))

               (identical? t "be")
               (do
                 (unchecked-set self "_bell" (nn (unchecked-get m "bell")
                                                 (inc (unchecked-get self "_bell"))))
                 (unchecked-set self "_medium" (nn (unchecked-get m "medium") -1))
                 (when-not (identical? (unchecked-get self "_medium") (seat-of self))
                   (unchecked-set self "_hintNot" -1))
                 (act self (nn (unchecked-get m "durMs") 4000)))

               (identical? t "hm")
               (unchecked-set self "_hintNot" (nn (unchecked-get m "not") -1))

               (identical? t "rv")
               (do (unchecked-set self "_rooms" (.slice ^js (nn (unchecked-get m "rooms") #js [])))
                   (unchecked-set self "_candles"
                                  (.slice ^js (nn (unchecked-get m "candles") #js []))))

               (identical? t "ov")
               (let [w (unchecked-get m "w")]
                 (when (identical? w (unchecked-get (unchecked-get self "peer") "myId"))
                   (unchecked-set self "wins" (inc (unchecked-get self "wins"))))
                 (.emit ^js self "matchEnd" (nn w nil)))

               (identical? t "sn")
               (do
                 (unchecked-set self "_order" (nn (unchecked-get m "order") #js []))
                 (unchecked-set self "_candles" (nn (unchecked-get m "candles") #js []))
                 (unchecked-set self "_rooms" (nn (unchecked-get m "rooms") #js []))
                 (unchecked-set self "_bell" (nn (unchecked-get m "bell") 0))
                 (unchecked-set self "_medium" (nn (unchecked-get m "medium") -1))
                 (when (identical? 1 (unchecked-get m "walk"))
                   (act self (nn (unchecked-get m "remainMs") 1000))))

               :else nil)))
         js/undefined))
  js/undefined)

(let [proto (.-prototype SeanceClient)]
  (js/Object.defineProperty proto "seat"
                            #js {:get (fn [] (this-as self (seat-of self)))
                                 :configurable true})
  ;; The attached host driver (null when this client can't conduct).
  (js/Object.defineProperty proto "host"
                            #js {:get (fn [] (this-as self (unchecked-get self "_host")))
                                 :configurable true})

  (unchecked-set proto "score" (fn [] (this-as self (unchecked-get self "wins"))))

  ;; SeanceView — six keys, literal order safe, and the ORDER is the gym
  ;; contract
  (unchecked-set
   proto "view"
   (fn []
     (this-as self
       (let [seat (seat-of self)]
         (js-obj "bell" (unchecked-get self "_bell")
                 "seat" seat
                 "candles" (.slice ^js (unchecked-get self "_candles"))
                 "rooms" (.slice ^js (unchecked-get self "_rooms"))
                 "hintNot" (unchecked-get self "_hintNot")
                 "isMedium" (and (identical? (unchecked-get self "_medium") seat) (>= seat 0)))))))

  ;; Pick a room 0..2 during a walk window.
  (unchecked-set proto "pick"
                 (fn [r] (this-as self
                           (.sendToHost ^js self (js-obj "t" "pk" "r" (bit-or r 0)))
                           js/undefined)))

  ;; Hosting only: start a séance now instead of waiting for auto-start.
  (unchecked-set proto "startMatch"
                 (fn [] (this-as self
                          (let [h (unchecked-get self "_host")]
                            (if ^boolean (js* "!!(~{})" h) (.startNow ^js h) false))))))

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