From 6593b49b74f7c7e8c868301af2953172f0b9f71a Mon Sep 17 00:00:00 2001 From: Corwin Brust Date: Tue, 23 Jun 2026 22:24:18 -0500 Subject: [PATCH] Add cg-net.el: host-authoritative TCP transport for multiplayer --- Makefile | 2 +- card-games.el | 1 + cg-net.el | 216 +++++++++++++++++++++++++++++++++++++++ test/card-games-tests.el | 34 ++++++ 4 files changed, 252 insertions(+), 1 deletion(-) create mode 100644 cg-net.el diff --git a/Makefile b/Makefile index dfdbcf9..d7d0f41 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ EMACS ?= emacs PKG = card-games VERSION = 1.0.50 # Source files in dependency order (cg-core first). -EL = cg-core.el cg-svg.el cg-render.el cg-bid.el cg-gaps.el cg-bid-ui.el card-games.el +EL = cg-core.el cg-svg.el cg-render.el cg-net.el cg-bid.el cg-gaps.el cg-bid-ui.el card-games.el ELC = $(EL:.el=.elc) PKGDESC = $(PKG)-pkg.el TARDIR = $(PKG)-$(VERSION) diff --git a/card-games.el b/card-games.el index b5350ad..cdae9bc 100644 --- a/card-games.el +++ b/card-games.el @@ -40,6 +40,7 @@ (require 'cg-core) (require 'cg-render) +(require 'cg-net) (require 'cg-gaps) (require 'cg-bid-ui) diff --git a/cg-net.el b/cg-net.el new file mode 100644 index 0000000..a79b5b5 --- /dev/null +++ b/cg-net.el @@ -0,0 +1,216 @@ +;;; cg-net.el --- Networked multiplayer for card games -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Corwin Brust + +;; Author: Corwin Brust +;; Maintainer: Corwin Brust +;; Version: 1.0.50 +;; Package-Requires: ((emacs "26.1")) +;; Keywords: games +;; URL: https://code.bru.st/corwin/card-game.el + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Host-authoritative networking for the card games. One Emacs is the +;; HOST: it owns the canonical game and listens for players. Other +;; Emacsen CONNECT as clients, send move "intents", and receive the new +;; game state to redraw. Because the games are turn-based there is +;; nothing to merge, so this is a simple authoritative server rather +;; than a CRDT; crdt.el is kept in reserve for any future free-form +;; shared state. +;; +;; Transport is line-delimited s-expressions over `make-network-process' +;; (plain TCP), so it works wherever Emacs has TCP -- including an +;; Android client joining a desktop host. A message is a plist with a +;; `:type' key: +;; +;; client -> host: (:type hello :name NAME) +;; (:type move :move MOVE) +;; host -> client: (:type welcome :seat N) +;; (:type state :state SEXP) +;; +;; A game plugs in by defining methods on `cg-net-apply-move' (host +;; side) and, if its state is not just the env plist, on +;; `cg-net-game-state' / `cg-net-set-game-state'. Clients add a +;; redraw function to `cg-net-state-functions'. + +;;; Code: + +(require 'cg-core) + +(defgroup cg-net nil + "Networked play for card games." + :group 'card-games + :prefix "cg-net-") + +(defcustom cg-net-port 7500 + "Default TCP port used to host or join a game." + :type 'integer :group 'cg-net) + +(defvar cg-net-state-functions nil + "Abnormal hook run on a client after the game state is updated. +Each function is called with the client's game object.") + +;;;; Game integration points + +(cl-defgeneric cg-net-apply-move (game seat move) + "Apply MOVE made by SEAT to GAME on the host. +Return non-nil when the move was accepted (and state should broadcast).") + +(cl-defgeneric cg-net-game-state (game) + "Return a `read'able representation of GAME's shared state.") + +(cl-defmethod cg-net-game-state ((game cg-game)) + "Default: return GAME's env plist as the shared state." + (oref game env)) + +(cl-defgeneric cg-net-set-game-state (game state) + "Replace GAME's shared state with STATE on a client.") + +(cl-defmethod cg-net-set-game-state ((game cg-game) state) + "Default: install STATE as GAME's env plist." + (oset game env state)) + +;;;; Wire protocol + +(defun cg-net--send (proc msg) + "Send MSG (a sexp) to PROC as one newline-terminated line." + (when (process-live-p proc) + (let ((print-length nil) (print-level nil)) + (process-send-string proc (concat (prin1-to-string msg) "\n"))))) + +(defun cg-net--filter (handler) + "Return a process filter dispatching each complete line to HANDLER. +HANDLER is called with (PROC MSG)." + (lambda (proc string) + (let ((buf (concat (or (process-get proc 'cg-net-buf) "") string)) + (start 0) nl) + (while (setq nl (string-search "\n" buf start)) + (let ((line (substring buf start nl))) + (setq start (1+ nl)) + (unless (string-empty-p line) + (condition-case err + (funcall handler proc (car (read-from-string line))) + (error (message "cg-net: bad message: %S" err))))) + ) + (process-put proc 'cg-net-buf (substring buf start))))) + +;;;; Host + +(cl-defstruct (cg-net-host (:constructor cg-net--host-make)) + server game (clients nil) (next-seat 0)) + +(defvar cg-net--host nil + "The running `cg-net-host', or nil when not hosting.") + +(defun cg-net-hosting-p () + "Return non-nil when this Emacs is hosting a game." + (and cg-net--host (process-live-p (cg-net-host-server cg-net--host)))) + +(defun cg-net-host-start (game &optional port) + "Begin hosting GAME on PORT (default `cg-net-port'). Return the server process." + (let* ((port (or port cg-net-port)) + (server (make-network-process + :name "cg-host" :server t :service port + :host "0.0.0.0" :family 'ipv4 :coding 'utf-8 + :log #'cg-net--host-accept))) + (setq cg-net--host (cg-net--host-make :server server :game game)) + server)) + +(defun cg-net-host-stop () + "Stop hosting and close all client connections." + (when cg-net--host + (dolist (c (cg-net-host-clients cg-net--host)) + (when (process-live-p c) (delete-process c))) + (when (process-live-p (cg-net-host-server cg-net--host)) + (delete-process (cg-net-host-server cg-net--host))) + (setq cg-net--host nil))) + +(defun cg-net--host-accept (_server connection _message) + "Set up an accepted CONNECTION: assign a seat and send the current state." + (let ((seat (cg-net-host-next-seat cg-net--host))) + (setf (cg-net-host-next-seat cg-net--host) (1+ seat)) + (push connection (cg-net-host-clients cg-net--host)) + (process-put connection 'cg-net-seat seat) + (set-process-coding-system connection 'utf-8 'utf-8) + (set-process-filter connection (cg-net--filter #'cg-net--host-handle)) + (cg-net--send connection (list :type 'welcome :seat seat)) + (cg-net--send connection + (list :type 'state + :state (cg-net-game-state (cg-net-host-game cg-net--host)))))) + +(defun cg-net--host-handle (proc msg) + "Handle one message MSG from a client PROC on the host." + (pcase (plist-get msg :type) + ('hello (process-put proc 'cg-net-name (plist-get msg :name))) + ('move + (let ((seat (process-get proc 'cg-net-seat)) + (game (cg-net-host-game cg-net--host))) + (when (cg-net-apply-move game seat (plist-get msg :move)) + (cg-net-host-broadcast)))))) + +(defun cg-net-host-broadcast () + "Send the current game state to every connected client." + (when cg-net--host + (let ((state (cg-net-game-state (cg-net-host-game cg-net--host)))) + (dolist (c (cg-net-host-clients cg-net--host)) + (cg-net--send c (list :type 'state :state state)))))) + +;;;; Client + +(cl-defstruct (cg-net-client (:constructor cg-net--client-make)) + proc game (seat nil)) + +(defvar cg-net--client nil + "The active `cg-net-client', or nil when not connected.") + +(defun cg-net-connected-p () + "Return non-nil when connected to a host as a client." + (and cg-net--client (process-live-p (cg-net-client-proc cg-net--client)))) + +(defun cg-net-connect (host port name game) + "Connect to HOST on PORT as NAME, syncing into the local GAME. +Return the new `cg-net-client'." + (let ((proc (make-network-process + :name "cg-client" :host host :service port + :family 'ipv4 :coding 'utf-8))) + (setq cg-net--client (cg-net--client-make :proc proc :game game)) + (set-process-coding-system proc 'utf-8 'utf-8) + (set-process-filter proc (cg-net--filter #'cg-net--client-handle)) + (cg-net--send proc (list :type 'hello :name name)) + cg-net--client)) + +(defun cg-net-disconnect () + "Disconnect from the host." + (when (and cg-net--client (process-live-p (cg-net-client-proc cg-net--client))) + (delete-process (cg-net-client-proc cg-net--client))) + (setq cg-net--client nil)) + +(defun cg-net--client-handle (_proc msg) + "Handle one message MSG from the host on a client." + (pcase (plist-get msg :type) + ('welcome (setf (cg-net-client-seat cg-net--client) (plist-get msg :seat))) + ('state + (let ((game (cg-net-client-game cg-net--client))) + (cg-net-set-game-state game (plist-get msg :state)) + (run-hook-with-args 'cg-net-state-functions game))))) + +(defun cg-net-send-move (move) + "Send MOVE to the host from this client." + (cg-net--send (cg-net-client-proc cg-net--client) (list :type 'move :move move))) + +(provide 'cg-net) +;;; cg-net.el ends here diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 2ef0e7e..bc0150a 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -35,6 +35,40 @@ (should (eq 'text (cg-render-resolve-treatment 'text))) (should (memq (cg-render-resolve-treatment 'auto) '(text svg)))) +;;;; Networking + +(defclass cgt-net-game (cg-game) + ((env :initarg :env :initform '(:counter 0))) + "Throwaway game whose only move adds to a counter.") + +(cl-defmethod cg-net-apply-move ((g cgt-net-game) _seat move) + (cg-put g :counter (+ (or (cg-get g :counter) 0) move)) + t) + +(ert-deftest cgt-net-loopback () + "Host-authoritative move sync over a loopback TCP socket." + ;; Skip gracefully where a TCP server cannot be opened. + (condition-case _ + (delete-process + (make-network-process :name "cgt-probe" :server t :service 0 + :host "127.0.0.1" :family 'ipv4)) + (error (ert-skip "TCP not available"))) + (let* ((hgame (make-instance 'cgt-net-game :env (list :counter 0))) + (srv (cg-net-host-start hgame 0)) + (port (process-contact srv :service)) + (cgame (make-instance 'cgt-net-game :env (list :counter 0)))) + (unwind-protect + (progn + (cg-net-connect "127.0.0.1" port "Test" cgame) + (dotimes (_ 12) (accept-process-output nil 0.05)) + (should (= 0 (cg-get cgame :counter))) + (cg-net-send-move 7) + (dotimes (_ 12) (accept-process-output nil 0.05)) + (should (= 7 (cg-get hgame :counter))) + (should (= 7 (cg-get cgame :counter)))) + (cg-net-disconnect) + (cg-net-host-stop)))) + ;;;; Gaps (ert-deftest cgt-gaps-deal ()