peer-kit / src / ardegazu / peer / games / neon_grid.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
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
;; ported-from: src/games/neon-grid.ts @ v1.3.0
;;
;; neon-grid (game1) — the light-cycle arena. Host-authoritative rounds on a
;; 128×96 grid: "st" starts a round with spawn seats, "tk" streams head
;; positions each tick, trails are the cells heads have crossed, "in" queues a
;; turn (0=up 1=right 2=down 3=left; 180° reversals are host-rejected).
;;
;; The client folds a per-seat trail map from the tick stream (cleared when a
;; rider derezzes, matching the authoritative grid) and exposes it through
;; view(). Steering: the stock wall-dodging autopilot, or your own onTick
;; policy — views here are field-identical to the gym's (seat, pos, dir, alive,
;; tickN, gw, gh, grid, heads — in that order), so a policy trained offline
;; plugs in unchanged.
(ns ardegazu.peer.games.neon-grid
  (:require [ardegazu.peer.obj :as obj]
            [ardegazu.peer.games.room :as room]
            [ardegazu.peer.games.host.neon-grid-host :as ng-host]
            [shadow.cljs.modern :refer (defclass)]))

(def ^:private GW 128)
(def ^:private GH 96)
(def ^:private DX #js [0 1 0 -1])
(def ^:private DY #js [-1 0 1 0])

(declare wire act steer)

(defclass NeonGridClient
  (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 "_dir" 0)
    (unchecked-set this "_alive" false)
    (unchecked-set this "_pos" #js [0 0])
    (unchecked-set this "_trail" (js/Uint8Array. (* GW GH)))
    (unchecked-set this "_heads" #js [])
    (unchecked-set this "_tickN" 0)
    (unchecked-set this "_phase" "idle")
    (unchecked-set this "_onTick" (unchecked-get opts "onTick"))
    (unchecked-set this "_autopilot" (not (identical? false (unchecked-get opts "autopilot"))))
    (unchecked-set this "_host" nil)
    (let [h (unchecked-get opts "host")]
      (when ^boolean (js* "!!(~{})" h)
        (let [driver (ng-host/NeonGridHost. this h)]
          (unchecked-set this "_host" driver)
          (unchecked-set this "hostDriver" driver))))
    (wire this)))

(unchecked-set NeonGridClient "joinGrid"
               (fn [opts]
                 (let [o (js/Object.assign (js-obj) opts)]
                   (unchecked-set o "app" "neon-grid")
                   ((unchecked-get NeonGridClient "join") o))))

(defn- blocked? [self x y]
  (or (< x 0) (< y 0) (>= x GW) (>= y GH)
      (not (identical? 0 (aget (unchecked-get self "_trail") (+ (* y GW) x))))))

(defn- steer [self]
  (let [pos (unchecked-get self "_pos")
        x (aget pos 0)
        y (aget pos 1)
        dir (unchecked-get self "_dir")
        ax (+ x (aget DX dir))
        ay (+ y (aget DY dir))
        ;; look two cells ahead so we turn before the wall, like a rider would
        a2x (+ ax (aget DX dir))
        a2y (+ ay (aget DY dir))]
    (when-not (and (not (blocked? self ax ay))
                   (not (and (blocked? self a2x a2y) (< (js/Math.random) 0.6))))
      (let [options (.filter #js [(mod (+ dir 1) 4) (mod (+ dir 3) 4)]
                             (fn [d] (not (blocked? self (+ x (aget DX d)) (+ y (aget DY d))))))]
        (when-not (zero? (.-length options)) ; boxed in — ride it out
          (let [d (aget options (js/Math.floor (* (js/Math.random) (.-length options))))]
            (unchecked-set self "_dir" d)
            (.steer ^js self d))))))
  js/undefined)

(defn- act [self]
  (let [on-tick (unchecked-get self "_onTick")]
    (if ^boolean (js* "!!(~{})" on-tick)
      (try
        (let [d (on-tick (.view ^js self))]
          (when-not ^boolean (js* "~{} == null" d)
            (unchecked-set self "_dir" (bit-and d 3))
            (.steer ^js self d)))
        ;; policy error — ride straight, the round continues
        (catch :default _ nil))
      (when (unchecked-get self "_autopilot") (steer self))))
  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")
                 trail (unchecked-get self "_trail")]
             (cond
               (identical? t "st")
               (let [order (nn (unchecked-get m "order") #js [])
                     starts (nn (unchecked-get m "starts") #js [])]
                 (unchecked-set self "_seat" (.indexOf ^js order my-id))
                 (.fill trail 0)
                 (unchecked-set self "_tickN" 0)
                 (unchecked-set self "_phase" "countdown")
                 (unchecked-set self "_heads"
                                (.map ^js starts (fn [s] #js [(aget s 0) (aget s 1)])))
                 (.forEach ^js starts
                           (fn [s i] (aset trail (+ (* (aget s 1) GW) (aget s 0)) (inc i))))
                 (let [seat (unchecked-get self "_seat")
                       mine (aget starts seat)]
                   (if (and (>= seat 0) ^boolean (js* "!!(~{})" mine))
                     (do (unchecked-set self "_pos" #js [(aget mine 0) (aget mine 1)])
                         (unchecked-set self "_dir" (aget mine 2))
                         (unchecked-set self "_alive" true))
                     (unchecked-set self "_alive" false))))

               (identical? t "tk")
               (let [seat (unchecked-get self "_seat")
                     heads (unchecked-get self "_heads")]
                 (unchecked-set self "_phase" "playing")
                 (unchecked-set self "_tickN" (nn (unchecked-get m "n")
                                                  (inc (unchecked-get self "_tickN"))))
                 (.forEach ^js (nn (unchecked-get m "h") #js [])
                           (fn [e]
                             (let [s (aget e 0) x (aget e 1) y (aget e 2) alive (aget e 3)]
                               (if ^boolean (js* "!!(~{})" alive)
                                 (do
                                   (when (identical? s seat)
                                     (let [pos (unchecked-get self "_pos")
                                           px (aget pos 0) py (aget pos 1)]
                                       (cond (> x px) (unchecked-set self "_dir" 1)
                                             (< x px) (unchecked-set self "_dir" 3)
                                             (> y py) (unchecked-set self "_dir" 2)
                                             (< y py) (unchecked-set self "_dir" 0))
                                       (unchecked-set self "_pos" #js [x y])
                                       (unchecked-set self "_alive" true)))
                                   (aset heads s #js [x y])
                                   (aset trail (+ (* y GW) x) (inc s)))
                                 (do
                                   (aset heads s nil)
                                   (when (identical? s seat) (unchecked-set self "_alive" false))
                                   ;; the derezzed rider's trail clears, matching
                                   ;; the host grid
                                   (let [want (inc s) n (.-length trail)]
                                     (dotimes [i n]
                                       (when (identical? (aget trail i) want)
                                         (aset trail i 0)))))))))
                 (when (unchecked-get self "_alive") (act self)))

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

               (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" "matchover")
                 (when ^boolean (js* "!!(~{})" mine) (unchecked-set self "points" (aget mine 1)))
                 (unchecked-set self "_alive" false)
                 (.emit ^js self "matchEnd" (nn (unchecked-get m "w") nil)))

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

               (identical? t "sn")
               ;; late join mid-round: rebuild the arena, ride next round
               (let [order (nn (unchecked-get m "order") #js [])
                     runs (nn (unchecked-get m "runs") #js [])
                     bikes (nn (unchecked-get m "bikes") #js [])
                     color-seat (js/Map.)]
                 (unchecked-set self "_phase" "playing")
                 (unchecked-set self "_tickN" (nn (unchecked-get m "n") 0))
                 (unchecked-set self "_seat" (.indexOf ^js order my-id))
                 (.fill trail 0)
                 (.forEach ^js bikes (fn [b s] (.set color-seat (inc (aget b 3)) (inc s))))
                 (loop [r 0 i 0]
                   (when (< r (.-length ^js runs))
                     (let [v (aget runs r)
                           c (aget runs (inc r))]
                       (when ^boolean (js* "!!(~{})" v)
                         (let [sv (let [x (.get color-seat v)]
                                    (if (identical? x js/undefined) 0 x))]
                           (when ^boolean (js* "!!(~{})" sv) (.fill trail sv i (+ i c)))))
                       (recur (+ r 2) (+ i c)))))
                 (unchecked-set self "_heads"
                                (.map ^js bikes
                                      (fn [b] (if (identical? 1 (aget b 2))
                                                #js [(aget b 0) (aget b 1)]
                                                nil))))
                 (let [seat (unchecked-get self "_seat")
                       mine (aget bikes seat)]
                   (if (and (>= seat 0) ^boolean (js* "!!(~{})" mine))
                     (do (unchecked-set self "_pos" #js [(aget mine 0) (aget mine 1)])
                         (unchecked-set self "_alive" (identical? 1 (aget mine 2))))
                     (unchecked-set self "_alive" false))))

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

(let [proto (.-prototype NeonGridClient)]
  (js/Object.defineProperty proto "seat"
                            #js {:get (fn [] (this-as self (unchecked-get self "_seat")))
                                 :configurable true})
  ;; The attached host driver (null when this client can't host).
  (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 "points"))))

  ;; live round beats idle claim, ties to lowest id (game1's bystander rule).
  (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"))))))))

  ;; NeonGridView — nine keys, so sequential sets (the eight-pair js-obj rule),
  ;; and the ORDER is the gym contract
  (unchecked-set
   proto "view"
   (fn []
     (this-as self
       (obj/ordered "seat" (unchecked-get self "_seat")
                    "pos" (.slice ^js (unchecked-get self "_pos"))
                    "dir" (unchecked-get self "_dir")
                    "alive" (unchecked-get self "_alive")
                    "tickN" (unchecked-get self "_tickN")
                    "gw" GW
                    "gh" GH
                    ;; a copy, safe to mutate
                    "grid" (js/Uint8Array. (unchecked-get self "_trail"))
                    "heads" (.map ^js (unchecked-get self "_heads")
                                  (fn [h] (if ^boolean (js* "!!(~{})" h) (.slice ^js h) nil)))))))

  ;; Queue a turn 0..3 (works both as guest and as host).
  (unchecked-set proto "steer"
                 (fn [d] (this-as self
                           (.sendToHost ^js self (js-obj "t" "in" "d" (bit-and d 3)))
                           js/undefined)))

  ;; Hosting only: start a match 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