switch backend to clojure

This commit is contained in:
Travis Shears 2026-04-16 12:04:23 +02:00
parent 99f73315b3
commit 09bf48481a
Signed by: travisshears
GPG key ID: CB9BF1910F3F7469
11 changed files with 228 additions and 159 deletions

View file

@ -0,0 +1,145 @@
(ns game-server.main
(:require
[aleph.udp :as udp]
[manifold.stream :as s]
[clj-commons.byte-streams :as bs]
[taoensso.telemere :as t]
[clojure.pprint :refer [pprint]]
[clojure.string :as str])
(:import (java.security MessageDigest))
(:gen-class))
;; UDP examples
;; - https://gist.github.com/crosstyan/8a87ebdb0c23e549b1c75e9e4013ffa5
(def port 9999)
(def players (atom {})) ; client registry: {player-id {:host ... :port ...}}
(def games (atom {:by-id {} :all []}))
;; Global socket reference for sending
(def server-socket (atom nil))
;; (defn parse-position-msg
;; "Parse: 'player-id:x:y' format"
;; [msg-str]
;; (try
;; (let [[player-id x y] (str/split msg-str #":")]
;; {:player-id (Integer/parseInt player-id)
;; :x (Double/parseDouble x)
;; :y (Double/parseDouble y)})
;; (catch Exception e
;; (t/log! {:level :warn :data {:msg msg-str :error (str e)}} "Failed to parse message")
;; nil)))
;;
;; (if waiting-game
;; (swap! games (fn [state]
;; (let )
;; :by-id (assoc (:by-id state) player-id {:player-1 }
;; (-> (:by-id state)
;; (assoc player-id waiting-game))
;; :waiting (disj (:waiting state) waiting-game)
;; :all (conj (:all state) waiting-game)
;; })))
;; (defn get-game-by-player-id [player-id]
;; (first (filter (fn [game] (or (= (:player-1 game) player-id) (= (:player-2 game) player-id))) @games)))
;; (defn get-waiting-game []
;; (first (filter (fn [game] (nil? (:player-2 game))) @games)))
;; (defn join-waiting-game! [player-id other-player-id]
;; (if-let [waiting-game (get-game-by-player-id other-player-id)]
;; (swap! games update-in [(.indexOf @games waiting-game)] assoc :player-2 player-id)
;; (swap! games conj {:player-1 player-id :player-2 nil})))
(defn md5 [s]
(let [md (MessageDigest/getInstance "MD5")
digest (.digest md (.getBytes s))]
(apply str (map #(format "%02x" %) digest))))
(defn send-to-player
"Send a UDP packet to a player"
[player-id message]
(if-let [player (get @players player-id)]
(try
(s/put! @server-socket
{:host (:host player)
:port (:port player)
:message message})
(catch Exception e
(t/log! {:level :warn :data {:player-id player-id :error (str e)}} "Failed to send to player")))
(t/log! {:level :warn :data {:player-id player-id}} "Player not found")))
(defn join-game! [player-id]
(let [waiting-game
(some-> (first (filter (fn [game] (nil? (:player-2 game))) (@games :all)))
(assoc :player-2 player-id))
other-player-id (:player-1 waiting-game)
new-game {:player-1 player-id :player-2 nil}]
(if waiting-game
(do
(swap! games (fn [state]
{:by-id
(-> (:by-id state)
(assoc player-id waiting-game)
(assoc other-player-id waiting-game))
:all (map (fn [game] (if (= (:player-1 game) other-player-id)
waiting-game
game)) (:all state))}))
(send-to-player other-player-id "READY_TO_PLAY")
(send-to-player player-id "READY_TO_PLAY"))
(do
(swap! games (fn [state]
{:by-id (assoc (:by-id state) player-id new-game)
:all (conj (:all state) new-game)}))
(send-to-player player-id "WAIT")))))
(defn register-player! [host port]
(let [player-id (md5 (str host port))]
(swap! players assoc player-id {:host host :port port})
(t/log! {:level :info :data {:player-id player-id}} "Player registered")
(join-game! player-id)
(pprint {:games @games :players @players})))
;; (defn broadcast-to-others [from-player-id position-data]
;; "Send position to all other players"
;; (let [other-players (dissoc @players from-player-id)
;; msg (str from-player-id ":" (:x position-data) ":" (:y position-data))]
;; (doseq [[pid _] other-players]
;; (send-to-player pid msg))))
(defn parse-packet [packet]
(let [host (-> packet (:sender) (bean) (:address) (bean) (:hostAddress))
port (-> packet (:sender) (bean) (:port))
vector-msg (-> packet (:message) (vec))
string-msg (bs/to-string (:message packet))
msg-parts (str/split string-msg #"#")]
{:host host
:port port
:msg (:message packet)
:msg-vec vector-msg
:msg-string string-msg
:msg-parts msg-parts}))
(defn packet-consumer [packet]
(t/log! {:level :info :data {:packet packet}} "Consuming packet")
(case (first (:msg-parts packet))
"REGISTER" (register-player! (:host packet) (:port packet))))
(defn start-server [port]
(let [socket @(udp/socket {:port port})]
(reset! server-socket socket)
(t/log! {:level :info :data {:port port}} "UDP server listening")
(->> socket
(s/map parse-packet)
(s/consume packet-consumer))
socket))
(defn -main []
(t/log! {:level :info :data {:port port}} "Game server starting")
(start-server port)
@(promise)) ;; keep server running