peer-kit / src / ardegazu / peer / games / lampion.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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
;; ported-from: src/games/lampion.ts @ v1.3.0
;;
;; lampion (game5) — the night climb on turning rings. 6 rings of shrinking
;; arcs over 12 angular slots; stairs connect rings per the per-round level;
;; rings auto-turn and can be turned by players. First to the summit wins.
;;
;; Client side: send "hi"/"in" (action codes 0..5) — receive "ro","st","tk",
;; "ov","ma","lo","fu","sn". Movement cooldown 2 ticks, ring-rotate 24; the host
;; silently drops long-premature rotates, so the bot paces itself.
;;
;; WORLD vs LOCAL SLOTS — the one idea the whole game turns on (game5's
;; game/sim.cljs is the spec of record): the wire carries WORLD slots (`starts`,
;; "tk".mv, "tk".fp, "sn".ps), while `level.stairs[r]` lists LOCAL slots, and
;; ring r's world slot is its local slot plus rots[r], mod S. So the stair
;; heuristic below MUST convert, and the client MUST track rots: they are seeded
;; from "st".level.rots (the round's opening set) — or, on a late join, from
;; "sn"'s TOP-LEVEL `rots` (the current set; "sn".level.rots is deliberately
;; empty, see game5's send-snap) — and then moved by every "tk".rt entry, which
;; also drags whoever stands on the turned ring.
;;
;; Host election: lampion browsers put `live: 1` on their "ro" while they host a
;; round, so claimBeats below overrides the base lowest-id rule with
;; live-beats-idle — the bot and the browsers must apply the SAME comparator or a
;; mixed room partitions (see room.cljs's header).
(ns ardegazu.peer.games.lampion
  (:require [ardegazu.peer.games.room :as room]
            [shadow.cljs.modern :refer (defclass)]))

(def ^:private A-CCW 0)
(def ^:private A-CW 1)
(def ^:private A-UP 2)

;; game5's config: S angular slots per ring, RINGS rings base -> summit.
(def ^:private S 12)
(def ^:private RINGS 6)

(declare wire climb)

(defclass LampionClient
  (extends room/GameRoom)
  (constructor [this peer opts]
    (super peer (let [o (js/Object.assign (js-obj) opts)]
                  (unchecked-set o "hiExtra" (fn [] (js-obj "score" (unchecked-get this "points"))))
                  o))
    (unchecked-set this "points" 0)
    (unchecked-set this "_seat" -1)
    (unchecked-set this "_ring" 0)
    ;; a WORLD slot, as the wire carries it
    (unchecked-set this "_slot" 0)
    (unchecked-set this "_level" nil)
    ;; authoritative rotation offset per ring (world slot = local + rot, mod S)
    (unchecked-set this "_rots" (.fill (js/Array. RINGS) 0))
    (unchecked-set this "_tick" 0)
    (unchecked-set this "_lastMove" -10)
    (unchecked-set this "_phase" "idle")
    (wire this)))

(unchecked-set LampionClient "joinLampion"
               (fn [opts]
                 (let [o (js/Object.assign (js-obj) opts)]
                   (unchecked-set o "app" "lampion")
                   ((unchecked-get LampionClient "join") o))))

(defn- ring-dist [a b]
  (let [d (mod (js/Math.abs (- a b)) S)]
    (js/Math.min d (- S d))))

;; game5's sim/s-mod — `(((x % S) + S) % S)`, written out so it can never drift
(defn- s-mod [x]
  (js-mod (+ (js-mod x S) S) S))

;; game5's sim/world-of and sim/local-of, verbatim.
(defn- world-of
  "World slot of ring r's local slot `local` under rotation set `rots`."
  [local r ^js rots]
  (s-mod (+ local (aget rots r))))

(defn- local-of
  "Local slot on ring r under `rots` for world slot `w`."
  [w r ^js rots]
  (s-mod (- w (aget rots r))))

(defn- rots-of
  "A private RINGS-long numeric copy of a wire rotation set — zero-filled where
   the frame carries nothing (\"sn\".level.rots is always empty, and pre-rots
   hosts omitted it), so world-of/local-of can never see an undefined offset."
  [^js a]
  (let [out (.fill (js/Array. RINGS) 0)]
    (when (js/Array.isArray a)
      (.forEach a (fn [v i]
                    (when (and (< i RINGS) (number? v)) (aset out i (s-mod v))))))
    out))

(defn- climb
  "Try the stairs when one is near, otherwise walk the ring toward one. `_slot`
   is a WORLD slot and `level.stairs[ring]` holds LOCAL ones, so both sides of
   every comparison are converted through the ring's rotation offset."
  [self]
  ;; respect the move cooldown
  (when-not (< (- (unchecked-get self "_tick") (unchecked-get self "_lastMove")) 3)
    (let [level (unchecked-get self "_level")
          slot (unchecked-get self "_slot")
          ring (unchecked-get self "_ring")
          rots (unchecked-get self "_rots")
          stairs (let [s (when ^boolean (js* "!!(~{})" level)
                           (let [all (unchecked-get level "stairs")]
                             (when ^boolean (js* "!!(~{})" all)
                               (aget all ring))))]
                   (if ^boolean (js* "~{} == null" s) #js [] s))
          act (cond
                (>= (.indexOf ^js stairs (local-of slot ring rots)) 0) A-UP

                (pos? (.-length ^js stairs))
                ;; walk toward the nearest stair around the ring — in WORLD
                ;; slots, the frame my own position is expressed in
                (let [target (.reduce (.map ^js stairs
                                            (fn [s] (world-of s ring rots)))
                                      (fn [best w]
                                        (if (< (ring-dist slot w) (ring-dist slot best))
                                          w best)))
                      cw (s-mod (- target slot))]
                  (if (<= cw 6) A-CW A-CCW))

                :else (if (< (js/Math.random) 0.5) A-CW A-CCW))]
      (unchecked-set self "_lastMove" (unchecked-get self "_tick"))
      (.sendToHost ^js self (js-obj "t" "in" "a" act))))
  js/undefined)

(defn- wire [self]
  (.on ^js self "frame"
       (fn [from m]
         (when (identical? from (unchecked-get self "hostId"))
           (let [t (unchecked-get m "t")
                 nn (fn [v d] (if ^boolean (js* "~{} == null" v) d v))
                 my-id (unchecked-get (unchecked-get self "peer") "myId")]
             (cond
               (identical? t "st")
               (let [order (nn (unchecked-get m "order") #js [])
                     starts (nn (unchecked-get m "starts") #js [])
                     level (nn (unchecked-get m "level") nil)]
                 (unchecked-set self "_seat" (.indexOf ^js order my-id))
                 (unchecked-set self "_level" level)
                 ;; the round opens on level.rots; "tk".rt moves them from there
                 (unchecked-set self "_rots"
                                (rots-of (when ^boolean (js* "!!(~{})" level)
                                           (unchecked-get level "rots"))))
                 (unchecked-set self "_ring" 0)
                 (unchecked-set self "_tick" 0)
                 (unchecked-set self "_phase" "countdown")
                 (let [seat (unchecked-get self "_seat")]
                   (when (>= seat 0)
                     (unchecked-set self "_slot" (nn (aget starts seat) 0)))))

               (identical? t "tk")
               (let [seat (unchecked-get self "_seat")]
                 (unchecked-set self "_phase" "playing")
                 (unchecked-set self "_tick" (nn (unchecked-get m "n")
                                                 (inc (unchecked-get self "_tick"))))
                 ;; rt FIRST, then mv, then fp — the host turns rings before it
                 ;; drains queued moves, so its mv slots are already post-turn
                 ;; (game5 sim/tick-step! and game/apply-tick keep this order)
                 (when (js/Array.isArray (unchecked-get m "rt"))
                   (let [rots (unchecked-get self "_rots")]
                     (.forEach ^js (unchecked-get m "rt")
                               (fn [e]
                                 (let [r (aget e 0)
                                       dir (aget e 1)]
                                   (when (and (>= r 0) (< r RINGS))
                                     (aset rots r (s-mod (+ (aget rots r) dir)))
                                     ;; a turning ring drags its riders, me included
                                     (when (identical? (unchecked-get self "_ring") r)
                                       (unchecked-set self "_slot"
                                                      (s-mod (+ (unchecked-get self "_slot")
                                                                dir))))))))))
                 (when (js/Array.isArray (unchecked-get m "mv"))
                   (.forEach ^js (unchecked-get m "mv")
                             (fn [e] (when (identical? (aget e 0) seat)
                                       (unchecked-set self "_ring" (aget e 1))
                                       (unchecked-set self "_slot" (aget e 2))))))
                 (when (js/Array.isArray (unchecked-get m "fp"))
                   (let [fp (unchecked-get m "fp")
                         mine (when (>= seat 0) (aget fp seat))]
                     (when ^boolean (js* "!!(~{})" mine)
                       (unchecked-set self "_ring" (aget mine 0))
                       (unchecked-set self "_slot" (aget mine 1)))))
                 (when (>= seat 0) (climb self)))

               (or (identical? t "ov") (identical? t "ma"))
               (let [scores (nn (unchecked-get m "scores") #js [])
                     mine (.find ^js scores (fn [e] (identical? (aget e 0) my-id)))]
                 (unchecked-set self "_phase" (if (identical? t "ov") "roundover" "matchover"))
                 (when ^boolean (js* "!!(~{})" mine) (unchecked-set self "points" (aget mine 1))))

               (identical? t "lo")
               (unchecked-set self "_phase" "lobby")

               (identical? t "sn")
               (let [order (nn (unchecked-get m "order") #js [])
                     ps (nn (unchecked-get m "ps") #js [])
                     level (nn (unchecked-get m "level") (unchecked-get self "_level"))
                     top (unchecked-get m "rots")]
                 (unchecked-set self "_seat" (.indexOf ^js order my-id))
                 (unchecked-set self "_level" level)
                 (unchecked-set self "_phase" "playing")
                 ;; "sn" carries the LIVE rotations at the top level; its
                 ;; level.rots is deliberately empty (game5's send-snap)
                 (unchecked-set self "_rots"
                                (if (and (js/Array.isArray top) (pos? (.-length ^js top)))
                                  (rots-of top)
                                  (rots-of (when ^boolean (js* "!!(~{})" level)
                                             (unchecked-get level "rots")))))
                 (let [seat (unchecked-get self "_seat")
                       mine (when (>= seat 0) (aget ps seat))]
                   (when ^boolean (js* "!!(~{})" mine)
                     (unchecked-set self "_ring" (aget mine 0))
                     (unchecked-set self "_slot" (aget mine 1)))))

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

(let [proto (.-prototype LampionClient)]
  (unchecked-set proto "score" (fn [] (this-as self (unchecked-get self "points"))))

  ;; live round beats idle claim, ties to lowest id — game5's bystander rule
  ;; (sim/bystander-claim-wins over round-live?: playing | countdown |
  ;; roundover). Identical in shape to neon-grid's; the browsers apply it too,
  ;; and a bot on the base lowest-id default would partition a mixed room.
  (unchecked-set
   proto "claimBeats"
   (fn [from m]
     (this-as self
       (if (nil? (unchecked-get self "hostId"))
         true
         (let [their-live (identical? 1 (unchecked-get m "live"))
               phase (unchecked-get self "_phase")
               my-host-live (or (identical? phase "playing")
                                (identical? phase "countdown")
                                (identical? phase "roundover"))]
           (if-not (identical? their-live my-host-live)
             their-live
             (< from (unchecked-get self "hostId")))))))))

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