From e41a5479abb533e058b1e1e447425c02276797b1 Mon Sep 17 00:00:00 2001 From: Gabriel Pariat Date: Thu, 10 Nov 2022 12:07:04 -0500 Subject: [PATCH] multiplayer works --- client/client.asd | 4 +- client/src/client.lisp | 83 ++++---------- client/src/create-online-game-scene.lisp | 2 +- client/src/game-scene.lisp | 34 ++++-- client/src/gui/package.lisp | 11 +- client/src/gui/text-field.lisp | 53 +++++++++ client/src/gui/text.lisp | 4 +- client/src/join-online-game-scene.lisp | 81 ++++++++++++++ client/src/local-game.lisp | 34 +++--- client/src/main-menu.lisp | 2 +- client/src/main.lisp | 7 -- client/src/online-game.lisp | 109 ++++++++++++++++--- client/src/package.lisp | 3 +- game/game.asd | 3 +- game/src/action.lisp | 29 ++--- game/src/game.lisp | 97 ++++++++++------- game/src/messages.lisp | 31 ++++++ game/src/package.lisp | 26 ++++- serializer.lisp | 14 +++ server/src/package.lisp | 2 +- server/src/server.lisp | 133 +++++++++++++++++------ 21 files changed, 540 insertions(+), 222 deletions(-) create mode 100644 client/src/gui/text-field.lisp create mode 100644 client/src/join-online-game-scene.lisp create mode 100644 game/src/messages.lisp create mode 100644 serializer.lisp diff --git a/client/client.asd b/client/client.asd index 98c063c..469b48a 100644 --- a/client/client.asd +++ b/client/client.asd @@ -21,10 +21,10 @@ (:file "line"))) (:file "utils") (:file "scene") - (:file "client") (:file "game-scene") (:file "local-game") (:file "online-game") (:file "main-menu") - (:file "main"))) + (:file "create-online-game-scene") + (:file "client"))) diff --git a/client/src/client.lisp b/client/src/client.lisp index 5675835..6d56b15 100644 --- a/client/src/client.lisp +++ b/client/src/client.lisp @@ -1,65 +1,24 @@ (in-package :pong.client) -(defparameter *client* nil) - -(defclass client () - ((ip :initarg :ip :initform nil :reader client-ip) - (port :initarg :port :initform nil :reader client-port) - (running-p :initform nil :accessor client-running-p) - (socket :initform nil :accessor client-socket))) - -(defmethod listen-to ((self client)) - (with-slots (running-p socket) self - (when (and running-p (usocket:wait-for-input socket :timeout 5) running-p) - (let ((data (cpk:decode-stream (usocket:socket-stream socket)))) - (format t "[CLIENT] Data received: ~a~%" data))))) - -(defmethod start ((self client)) - (with-slots (ip port running-p socket) self - (format t "uh?~%") - (unless running-p - (setf running-p t) - (setf socket (usocket:socket-connect ip port :element-type 'unsigned-byte))))) - -(defmethod stop ((self client)) - (with-slots (running-p socket) self - (setf running-p nil) - (when socket - (usocket:socket-close socket)) - (setf socket nil))) - -(defmethod write-to ((self client) data) - (let ((stream (usocket:socket-stream (client-socket self)))) - (format t "[CLIENT] Data sent: ~a~%" data) - (cpk:encode data :stream stream) - (force-output stream))) - -(defun handle-client () - (loop while (and *client* (client-running-p *client*)) - do (let ((data (listen-to *client*)))))) - -(defun start-client (ip port) - (unless *client* - (setf *client* (make-instance 'client :ip ip :port port)) - (start *client*) - (bt:make-thread #'handle-client))) - -(defun stop-client () - (when *client* - (stop *client*)) - (setf *client* nil)) - -(defun send-data-to-server (data) - (write-to *client* data)) - -(defun test-client () - (start-client "127.0.0.1" 54321) - (write-to *client* "hello!") - (sleep 1.015) - (write-to *client* "bye!") - (stop-client)) - -;; (test-client) - -;; (stop-client) +(defun main () + (let* ((last-time nil) + (current-time (get-internal-real-time))) + (r:with-window (800 600 "Pariatech's Pong") + (gui:with-gui + (open-main-menu) + + (r:set-config-flags r:+flag-window-resizable+) + (r:set-target-fps 60) + (r:set-exit-key 0) + (loop + until (or (r:window-should-close) (scene-should-close *scene*)) + do (setf last-time current-time) + (setf current-time (/ (get-internal-real-time) internal-time-units-per-second)) + + (let ((timelapse (- current-time last-time))) + (on-update *scene* timelapse)) + (r:with-drawing + (r:clear-background r:+gray+) + (on-draw *scene*) + (r:draw-fps 20 20))))))) diff --git a/client/src/create-online-game-scene.lisp b/client/src/create-online-game-scene.lisp index 27ac91c..3c2b3c5 100644 --- a/client/src/create-online-game-scene.lisp +++ b/client/src/create-online-game-scene.lisp @@ -44,7 +44,7 @@ when (= key r:+key-backspace+) do (setf name (str:substring 0 -1 name)) when (= key r:+key-enter+) - do (start-online-game) + do (create-online-game name) when (and (>= key 32) (<= key 96)) do (setf name (str:concat name (string (code-char key))))))) diff --git a/client/src/game-scene.lisp b/client/src/game-scene.lisp index b9513f8..57967a0 100644 --- a/client/src/game-scene.lisp +++ b/client/src/game-scene.lisp @@ -13,7 +13,8 @@ (quit-menu :initarg :quit-menu :initform nil :reader game-scene-quit-menu) (quit-menu-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text) (quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes) - (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no))) + (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no) + (code :initarg :code :initform nil :reader game-scene-code))) (defun open-game (game) (let ((root-element (gui:make-rectangle :color r:+darkgray+ @@ -67,7 +68,12 @@ :font +score-font+ :font-size +score-txt-size+ :h-align :center - :text "No"))) + :text "No")) + (code (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :x +score-padding+ + :v-align :bottom))) (gui:add-children quit-menu quit-menu-text @@ -83,7 +89,8 @@ ball line left-player - right-player) + right-player + code) (g:on-init game) @@ -100,7 +107,8 @@ :quit-menu quit-menu :quit-menu-text quit-menu-text :quit-menu-yes quit-menu-yes - :quit-menu-no quit-menu-no))) + :quit-menu-no quit-menu-no + :code code))) (defun position-score (el direction) (setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) +score-padding+))) @@ -117,12 +125,13 @@ (setf (gui:x el) (gui:w (gui:parent el)))) (defun position-ball (ball el) - (let ((ball-xy (g:ball-xy ball)) + (let ((ball-x (g:ball-x ball)) + (ball-y (g:ball-y ball)) (parent (gui:parent el))) (setf (gui:w el) (* g:+ball-radius+ (gui:w parent) 2)) (setf (gui:h el) (* g:+ball-radius+ (gui:h parent) 2)) - (setf (gui:x el) (* (v:vx ball-xy) (gui:w parent))) - (setf (gui:y el) (* (v:vy ball-xy) (gui:h parent))))) + (setf (gui:x el) (* ball-x (gui:w parent))) + (setf (gui:y el) (* ball-y (gui:h parent))))) (defun position-line (el) (setf (gui:x el) (floor (gui:w (gui:parent el)) 2)) @@ -143,6 +152,9 @@ (setf (gui:y no) (+ (gui:y text) (gui:h text) +score-padding+)) (setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +score-padding+))) +(defun position-code (el) + (setf (gui:y el) (- (gui:h (gui:parent el)) +score-padding+))) + (defmethod on-update ((scene game-scene) timelapse) (g:on-update (game-scene-game scene) timelapse) @@ -155,10 +167,11 @@ (g:pause (game-scene-game scene)) (setf (gui:visible (game-scene-quit-menu scene)) t)) (when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+) + (g:on-quit (game-scene-game scene)) (open-main-menu))) (defmethod on-draw ((scene game-scene)) - (with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no) + (with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no code) scene (let ((game-state (g:game-state game))) (position-root root-element) @@ -173,4 +186,7 @@ (setf (gui:text left-player) (g:state-left-player game-state)) (setf (gui:text right-player) (g:state-right-player game-state)) (position-right-player right-player) - (position-quit-menu quit-menu quit-menu-text quit-menu-yes quit-menu-no)))) + (position-quit-menu quit-menu quit-menu-text quit-menu-yes quit-menu-no) + (setf (gui:text code) (when (eq (type-of game) 'online-game) + (format nil "Code: ~a" (g:game-code game)))) + (position-code code)))) diff --git a/client/src/gui/package.lisp b/client/src/gui/package.lisp index 9e97305..bf9528e 100644 --- a/client/src/gui/package.lisp +++ b/client/src/gui/package.lisp @@ -35,4 +35,13 @@ #:make-text #:make-rectangle #:make-line - #:with-gui)) + #:with-gui) + ;; text-field.lisp + (:export #:text-field + #:focusp + #:border + #:border-color + #:border-thickness + #:cursor + #:padding + #:make-text-field)) diff --git a/client/src/gui/text-field.lisp b/client/src/gui/text-field.lisp new file mode 100644 index 0000000..7310e57 --- /dev/null +++ b/client/src/gui/text-field.lisp @@ -0,0 +1,53 @@ +(in-package #:gui) + +(defclass text-field (text) + ((focusp :initarg :focusp :initform nil :accessor focusp) + (border :initarg :border :initform :solid :accessor border) + (border-color :initarg :border-color :initform r:+black+ :accessor border-color) + (border-thickness :initarg :border-thickness :initform 1 :accessor border-thickness) + (cursor :initarg :cursor :initform nil :accessor cursor) + (padding :initarg :padding :initform 0 :accessor padding))) + +(defmethod calculate-size ((txt text-field)) + (with-slots (w h font font-size text spacing padding) txt + (when (and font text) + (let ((size (r:measure-text-ex (load-font font font-size) + text + (float font-size) + spacing))) + (setf w (+ (v:vx size) (* padding 2))) + (setf h (+ (v:vy size) (* padding 2))) + (update-x txt) + (update-y txt))))) + +(defmethod draw ((self text-field)) + (with-slots (font font-size text screen-x screen-y w h color spacing visible focusp border border-thickness border-color cursor padding) self + (when visible + (when border + (r:draw-rectangle-lines-ex (r:make-rectangle :x screen-x + :y screen-y + :width w + :height h) + (float border-thickness) + border-color)) + (when focusp + (r:draw-line-e) + (r:draw-text-ex (load-font font font-size) + (concatenate 'string + (str:repeat cursor " ") + (string #\left_one_eighth_block)) + (v:vec (float (+ screen-x padding)) (float (+ screen-y padding))) + (float font-size) + spacing + color)) + (when text + (r:draw-text-ex (load-font font font-size) + text + (v:vec (float (+ screen-x padding)) (float (+ screen-y padding))) + (float font-size) + spacing + color))))) + +(defmacro make-text-field (&rest args) + `(make-instance 'text-field ,@args)) + diff --git a/client/src/gui/text.lisp b/client/src/gui/text.lisp index b359147..a769621 100644 --- a/client/src/gui/text.lisp +++ b/client/src/gui/text.lisp @@ -19,7 +19,7 @@ (defmethod draw ((text text)) (with-slots (font font-size text screen-x screen-y color spacing visible) text - (when visible + (when (and visible text) (r:draw-text-ex (load-font font font-size) text (v:vec (float screen-x) (float screen-y)) @@ -29,7 +29,7 @@ (defmethod calculate-size ((txt text)) (with-slots (w h font font-size text spacing) txt - (when font + (when (and font text) (let ((size (r:measure-text-ex (load-font font font-size) text (float font-size) diff --git a/client/src/join-online-game-scene.lisp b/client/src/join-online-game-scene.lisp new file mode 100644 index 0000000..6a0f13a --- /dev/null +++ b/client/src/join-online-game-scene.lisp @@ -0,0 +1,81 @@ +(in-package :pong.client) + +(defclass join-online-game-scene (scene) + ((name :initform "" :accessor join-online-game-scene-name) + (code :initform "" :accessor join-online-game-scene-code) + (title :initarg :title :initform nil :reader join-online-game-scene-title) + (name-field :initarg :name-field + :initform nil + :reader join-online-game-scene-name-field) + (name-prompt :initarg :name-prompt + :initform nil + :reader join-online-game-scene-name-prompt) + (code-field :initarg :code-field + :initform nil + :reader join-online-game-scene-code-field) + (code-prompt :initarg :code-prompt + :initform nil + :reader join-online-game-scene-code-prompt) + (join-button :initarg :join-button + :initform nil + :reader join-online-game-scene-join-button))) + +(defun open-join-online-game-scene () + (let ((root-element (gui:make-rectangle :color r:+darkgray+ + :h-align :center + :v-align :middle)) + (title (gui:make-text :color r:+white+ + :font +menu-font+ + :font-size +menu-title-font-size+ + :y +title-top-padding+ + :h-align :center + :text "Join online game")) + (name-field (gui:make-text-field :color r:+white+ + :font +menu-font+ + :font-size +menu-font-size+ + :focusp t + :border :solid + :border-color r:+white+ + :border-thickness 1 + :cursor 0 + :padding 5)) + (name-prompt (gui:make-text :color r:+white+ + :font +menu-font+ + :font-size +menu-font-size+ + :h-align :right + :v-align :middle + :text "What is your name?:"))) + + (gui:add-children root-element title name-field name-prompt) + + (set-scene (make-instance 'join-online-game-scene :root-element root-element + :title title + :name-field name-field + :name-prompt name-prompt)))) + +(defmethod on-update ((scene join-online-game-scene) timelapse) + (with-slots (name move-back) scene + ;; Might be interesting to add repeating keys, but I don't care. + (loop for key = (r:get-key-pressed) + while (plusp key) + do (format t "~a~%" key) + when (= key r:+key-escape+) + do (open-main-menu) + when (= key r:+key-backspace+) + do (setf name (str:substring 0 -1 name)) + ;; when (= key r:+key-enter+) + ;; do (create-online-game name) + when (and (>= key 32) (<= key 96)) + do (setf name (str:concat name (string (code-char key)))))) + ) + +(defmethod on-draw ((scene join-online-game-scene)) + (with-slots (name code root-element title name-field name-prompt) scene + (position-root root-element) + (setf (gui:x title) (floor (gui:w root-element) 2)) + (setf (gui:text name-field) name) + (setf (gui:x name-field) (+ (floor (gui:w root-element) 2) +score-padding+)) + (setf (gui:x name-prompt) (- (floor (gui:w root-element) 2) +score-padding+)) + (setf (gui:y name-field) (floor (gui:h root-element) 2)) + (setf (gui:y name-prompt) (floor (gui:h root-element) 2))) + ) diff --git a/client/src/local-game.lisp b/client/src/local-game.lisp index e7541af..65e3af6 100644 --- a/client/src/local-game.lisp +++ b/client/src/local-game.lisp @@ -34,8 +34,8 @@ (let* ((right-paddle (g:state-right-paddle state)) (paddle-y (g:paddle-y right-paddle)) (ball (g:state-ball state)) - (ball-xy (g:ball-xy ball)) - (ball-y (v:vy ball-xy)) + (ball-x (g:ball-x ball)) + (ball-y (g:ball-y ball)) (paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2)))))) @@ -59,9 +59,8 @@ (< py (+ ry rh)))) (defun get-ball-paddle-collision (ball paddle paddle-x) - (let* ((ball-xy (g:ball-xy ball)) - (ball-x (v:vx ball-xy)) - (ball-y (v:vy ball-xy)) + (let* ((ball-x (g:ball-x ball)) + (ball-y (g:ball-y ball)) (paddle-y (g:paddle-y paddle))) (when (or (point-in-rect-p (- ball-x g:+ball-radius+) (- ball-y g:+ball-radius+) @@ -91,11 +90,10 @@ (defun handle-ball (state timelapse) (let* ((ball (g:state-ball state)) - (ball-xy (g:ball-xy ball)) - (ball-x (v:vx ball-xy)) - (ball-y (v:vy ball-xy)) - (ball-vxy (g:ball-vxy ball)) - (ball-vy (v:vy ball-vxy)) + (ball-x (g:ball-x ball)) + (ball-y (g:ball-y ball)) + (ball-vx (g:ball-vx ball)) + (ball-vy (g:ball-vy ball)) (left-paddle (g:state-left-paddle state)) (right-paddle (g:state-right-paddle state)) (ball-left-paddle-collision @@ -127,19 +125,19 @@ (incf (g:state-left-score state)) (g:random-launch-ball state)) ((< (- ball-y g:+ball-radius+) 0) - (setf (v:vy ball-xy) g:+ball-radius+) - (setf (v:vy ball-vxy) (* -1 ball-vy))) + (setf (g:ball-y ball) g:+ball-radius+) + (setf (g:ball-vy ball) (* -1 ball-vy))) ((> (+ ball-y g:+ball-radius+) 1) - (setf (v:vy ball-xy) (- 1 g:+ball-radius+)) - (setf (v:vy ball-vxy) (* -1 ball-vy))) + (setf (g:ball-y ball) (- 1 g:+ball-radius+)) + (setf (g:ball-vy ball) (* -1 ball-vy))) (t - (setf (g:ball-xy ball) (v:v+ ball-xy (v:v* ball-vxy timelapse))))))) + (incf (g:ball-x ball) (* ball-vx timelapse)) + (incf (g:ball-y ball) (* ball-vy timelapse)))))) (defun computer-paddle-target (game) (let* ((game-state (g:game-state game)) - (ball (g:state-ball game-state)) - (ball-vxy (g:ball-vxy ball))) - (if (plusp (v:vx ball-vxy)) + (ball (g:state-ball game-state))) + (if (plusp (g:ball-vx ball)) (or (local-game-1p-computer-paddle-target game) (setf (local-game-1p-computer-paddle-target game) (random g:+paddle-height+))) diff --git a/client/src/main-menu.lisp b/client/src/main-menu.lisp index bc80c63..6e3e212 100644 --- a/client/src/main-menu.lisp +++ b/client/src/main-menu.lisp @@ -76,7 +76,7 @@ :font-size +menu-font-size+ :color +menu-text-color+ :h-align :center) - :action #'open-create-online-game-scene)) + :action #'open-join-online-game-scene)) (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join)) (gui:h (menu-item-text online-join))) :h-align :center diff --git a/client/src/main.lisp b/client/src/main.lisp index 3ecb81e..e7f6321 100644 --- a/client/src/main.lisp +++ b/client/src/main.lisp @@ -1,12 +1,5 @@ (in-package :pong.client) - -(defun create-online-game () - (setf *scene* (open-create-online-game-scene))) - -(defun join-online-game () - (format t "~%Join online game.")) - (defun main () (let* ((last-time nil) (current-time (get-internal-real-time))) diff --git a/client/src/online-game.lisp b/client/src/online-game.lisp index fbb1925..6a6db5f 100644 --- a/client/src/online-game.lisp +++ b/client/src/online-game.lisp @@ -1,18 +1,78 @@ (in-package :pong.client) -(defclass online-game (g:game) - ((actions :initarg :actions :initform nil :accessor online-game-actions) - (keyboard :initform (make-hash-table) :reader online-game-keyboard) +(defparameter *socket* nil) +(defparameter *stream* nil) +(defparameter *game* nil) +(defparameter *lock* (bt:make-lock)) + +(defclass online-game (g:online-game) + ((keyboard :initform (make-hash-table) :reader online-game-keyboard) (paddle :initarg :paddle :initform :left :reader online-game-paddle))) -(defun start-online-game (&optional (paddle :left)) - (set-scene (open-game (make-instance 'online-game :paddle paddle)))) +(defun get-time () + (/ (get-internal-real-time) internal-time-units-per-second)) + +(defun apply-actions (game) + (let* ((state-timestamp (g:state-timestamp (g:game-state game))) + (last-time state-timestamp)) + (loop for action in (g:actions game) + when (>= (g:action-timestamp action) state-timestamp) + do (g:on-update game (- (g:action-timestamp action) last-time)) + (setf last-time (g:action-timestamp action)) + (g:apply-action action game)) + (let ((current-time (get-time))) + (g:on-update game (- current-time last-time)) + (setf (g:state-timestamp (g:game-state game)) current-time)) + (setf (g:actions game) nil))) + +(defun game-thread () + (when (usocket:wait-for-input *socket* :ready-only t :timeout 5) + (bt:with-lock-held (*lock*) + (when *game* + (let ((msg (cpk:decode-stream *stream*))) + (setf (g:game-state *game*) (g:game-state msg)) + (apply-actions *game*))))) + (when *game* + (game-thread))) + +(defun start-online-game% (game) + (setf *game* game) + (set-scene (open-game *game*)) + (bt:make-thread #'game-thread)) + +(defmacro start-online-game (&rest args) + `(start-online-game% (make-instance 'online-game ,@args))) + +(defun open-socket () + (setf *socket* (usocket:socket-connect "127.0.0.1" 54321 :element-type 'unsigned-byte)) + (setf *stream* (usocket:socket-stream *socket*))) + +(defun write-to-server (data) + (cpk:encode data :stream *stream*) + (force-output *stream*)) -(defun open-create-online-game-scene () - (start-online-game :left)) +(defun join-online-game () + (open-socket) + (start-online-game)) + +(defun create-online-game (name) + (open-socket) + (write-to-server (make-instance 'g:create-game-message :player-name name)) + (usocket:wait-for-input *socket*) ;; wait for response + + ;; should be game-created-message + (let* ((response (cpk:decode-stream *stream*)) + (game-code (g:game-code response)) + (player-paddle (g:player-paddle response)) + (game-state (g:game-state response))) + (start-online-game :code game-code + :paddle player-paddle + :state game-state))) (defmethod g:on-init ((game online-game)) - (g:random-launch-ball (g:game-state game))) + (format t "~a~%" game) + ;; (g:random-launch-ball (g:game-state game)) + ) (defun is-first-key-down-p (key keyboard) (and (r:is-key-down key) (not (gethash key keyboard)))) @@ -23,33 +83,46 @@ (defun set-key-down (key keyboard) (setf (gethash key keyboard) (r:is-key-down key))) -(defmethod g:on-update ((game online-game) timelapse) - (with-slots (actions keyboard paddle) game +(defun handle-action (action game) + (bt:with-lock-held (*lock*) + (g:apply-action action game) + (push action (g:actions game))) + (write-to-server (make-instance 'g:game-action-message + :game-code (g:game-code game) + :game-action action))) + +(defmethod g:on-update :before ((game online-game) timelapse) + (with-slots (keyboard paddle) game (when (or (is-first-key-down-p r:+key-s+ keyboard) (is-first-key-down-p r:+key-down+ keyboard)) (set-key-down r:+key-s+ keyboard) (set-key-down r:+key-down+ keyboard) (let ((action (make-instance 'g:start-down-action :paddle paddle))) - (g:apply-action action game) - (push action actions))) + (handle-action action game))) + (when (or (is-first-key-released-p r:+key-s+ keyboard) (is-first-key-released-p r:+key-down+ keyboard)) (set-key-down r:+key-s+ keyboard) (set-key-down r:+key-down+ keyboard) (let ((action (make-instance 'g:stop-down-action :paddle paddle))) - (g:apply-action action game) - (push action action))) + (handle-action action game))) + (when (or (is-first-key-down-p r:+key-w+ keyboard) (is-first-key-down-p r:+key-up+ keyboard)) (set-key-down r:+key-w+ keyboard) (set-key-down r:+key-up+ keyboard) (let ((action (make-instance 'g:start-up-action :paddle paddle))) - (g:apply-action action game) - (push action actions))) + (handle-action action game))) + (when (or (is-first-key-released-p r:+key-w+ keyboard) (is-first-key-released-p r:+key-up+ keyboard)) (set-key-down r:+key-w+ keyboard) (set-key-down r:+key-up+ keyboard) (let ((action (make-instance 'g:stop-up-action :paddle paddle))) - (g:apply-action action game) - (push action actions))))) + (handle-action action game))))) + +(defmethod g:on-quit ((game online-game)) + (usocket:socket-close *socket*) + (setf *socket* nil) + (setf *stream* nil) + (setf *game* nil)) diff --git a/client/src/package.lisp b/client/src/package.lisp index 4a18167..ff4bcae 100644 --- a/client/src/package.lisp +++ b/client/src/package.lisp @@ -1,5 +1,4 @@ (defpackage :pong.client (:use :cl) (:local-nicknames (:r :raylib) - (:v :3d-vectors) - (:g :pong.game))) + (:v :3d-vectors))) diff --git a/game/game.asd b/game/game.asd index 00680f6..9b88379 100644 --- a/game/game.asd +++ b/game/game.asd @@ -11,5 +11,6 @@ :components ((:file "package") (:file "game") - (:file "action"))) + (:file "action") + (:file "messages"))) diff --git a/game/src/action.lisp b/game/src/action.lisp index b417e46..f0794fc 100644 --- a/game/src/action.lisp +++ b/game/src/action.lisp @@ -3,31 +3,24 @@ (defclass action () ((timestamp :initarg :timestamp :initform (/ (get-internal-real-time) internal-time-units-per-second) - :reader action-timestamp))) + :reader action-timestamp) + (paddle :initarg :paddle :initform nil :reader paddle))) (defgeneric apply-action (action game)) -(defclass start-game-action (action) - ((name :initarg :name :initform nil :accessor name))) +(defclass start-down-action (action) ()) -(defclass start-down-action (action) - ((paddle :initarg :paddle :initform nil :reader paddle))) +(defclass stop-down-action (action) ()) -(defclass stop-down-action (action) - ((paddle :initarg :paddle :initform nil :reader paddle))) +(defclass start-up-action (action) ()) -(defclass start-up-action (action) - ((paddle :initarg :paddle :initform nil :reader paddle))) +(defclass stop-up-action (action) ()) -(defclass stop-up-action (action) - ((paddle :initarg :paddle :initform nil :reader paddle))) - -(cpk:defencoding action timestamp) -(cpk:defencoding start-game-action name) -(cpk:defencoding start-down-action paddle) -(cpk:defencoding stop-down-action paddle) -(cpk:defencoding start-up-action paddle) -(cpk:defencoding stop-up-action paddle) +(cpk:defencoding action timestamp paddle) +(cpk:defencoding start-down-action timestamp paddle) +(cpk:defencoding stop-down-action timestamp paddle) +(cpk:defencoding start-up-action timestamp paddle) +(cpk:defencoding stop-up-action timestamp paddle) (defun get-paddle (paddle state) (case paddle diff --git a/game/src/game.lisp b/game/src/game.lisp index 2af1ad3..6058e2c 100644 --- a/game/src/game.lisp +++ b/game/src/game.lisp @@ -12,13 +12,15 @@ (vy 0.0 :type float)) (defstruct ball - (xy (make-instance 'v:vec2) :type v:vec2) - (vxy (make-instance 'v:vec2) :type v:vec2)) + (x 0.0 :type float) + (y 0.0 :type float) + (vx 0.0 :type float) + (vy 0.0 :type float)) (defclass state () ((timestamp :initarg :timestamp :initform (/ (get-internal-real-time) internal-time-units-per-second) - :reader state-timestamp) + :accessor state-timestamp) (left-paddle :initarg :left-paddle :initform (make-paddle :y 0.5) :accessor state-left-paddle) @@ -26,7 +28,7 @@ :initform (make-paddle :y 0.5) :accessor state-right-paddle) (ball :initarg :ball - :initform (make-ball :xy (v:vec2 0.5 0.5)) + :initform (make-ball :x 0.5 :y 0.5) :accessor state-ball) (bounces :initarg :bounces :initform 0 @@ -38,22 +40,40 @@ :initform 0 :accessor state-right-score) (left-player :initarg :left-player - :initform "You" + :initform nil :accessor state-left-player) (right-player :initarg :right-player - :initform "Opponent" + :initform nil :accessor state-right-player) (paused :initarg :paused :initform nil :reader state-paused))) +(cpk:defencoding state timestamp left-paddle right-paddle ball bounces left-score right-score left-player right-player paused) +(cpk:defencoding paddle y vy) +(cpk:defencoding ball x y vx vy) + +(defun random-game-code (length) + (let ((chars "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") + (password (make-string length))) + (dotimes (i length) + (setf (aref password i) (aref chars (random (length chars))))) + password)) + (defclass game () - ((state :initarg :game-state + ((state :initarg :state :initform (make-instance 'state) :accessor game-state))) +(defclass online-game (game) + ((code :initarg :code + :initform (random-game-code 6) + :reader game-code) + (actions :initarg :actions :initform nil :accessor actions))) + (defgeneric on-update (game timelapse)) (defgeneric on-init (game)) +(defgeneric on-quit (game)) (defun update-paddle (paddle timelapse) (setf (paddle-y paddle) @@ -68,9 +88,8 @@ (< py (+ ry rh)))) (defun get-ball-paddle-collision (ball paddle paddle-x) - (let* ((ball-xy (ball-xy ball)) - (ball-x (v:vx ball-xy)) - (ball-y (v:vy ball-xy)) + (let* ((ball-x (ball-x ball)) + (ball-y (ball-y ball)) (paddle-y (paddle-y paddle))) (when (or (point-in-rect-p (- ball-x +ball-radius+) (- ball-y +ball-radius+) @@ -98,10 +117,24 @@ +paddle-height+)) (- ball-y paddle-y)))) +(defmethod launch-ball ((ball ball) bounces rad x y) + (let* ((v (v:v* (v:vec (cos rad) (sin rad)) (* (log (+ bounces 2)) +ball-speed+)))) + (setf (ball-x ball) x) + (setf (ball-y ball) y) + (setf (ball-vx ball) (v:vx v)) + (setf (ball-vy ball) (v:vy v)))) + +(defmethod random-launch-ball ((state state)) + (launch-ball (state-ball state) + (setf (state-bounces state) 0) + (+ (random +max-launch-angle+) (* (random 2) pi)) + 0.5 + (random 1.0))) + (defun update-ball (state ball left-paddle right-paddle timelapse) - (with-slots (xy vxy) ball - (incf (v:vx xy) (* (v:vx vxy) timelapse)) - (incf (v:vy xy) (* (v:vy vxy) timelapse)) + (with-slots (x y vx vy) ball + (incf x (* vx timelapse)) + (incf y (* vy timelapse)) (let ((ball-left-paddle-collision (get-ball-paddle-collision ball left-paddle 0.0)) (ball-right-paddle-collision @@ -114,7 +147,7 @@ (+ (/ +paddle-height+ 2) +ball-radius+)) +max-launch-angle+) (+ +paddle-width+ +ball-radius+) - (v:vy xy))) + y)) (ball-right-paddle-collision (launch-ball ball (incf (state-bounces state)) @@ -123,21 +156,21 @@ (+ (/ +paddle-height+ 2) +ball-radius+)) (/ +max-launch-angle+ 2))) (- 1.0 +paddle-width+ +ball-radius+) - (v:vy xy))) - ((minusp (+ (v:vx xy) +ball-radius+)) + y)) + ((minusp (+ x +ball-radius+)) (incf (state-right-score state)) (random-launch-ball state)) - ((> (- (v:vx xy) +ball-radius+) 1) + ((> (- x +ball-radius+) 1) (incf (state-left-score state)) (random-launch-ball state)) - ((minusp (- (v:vy xy) +ball-radius+)) - (setf (v:vy xy) (+ (- (v:vy xy)) (* +ball-radius+ 2))) - (setf (v:vy vxy) (- (v:vy vxy)))) - ((> (+ (v:vy xy) +ball-radius+) 1) - (setf (v:vy xy) (- 2 (v:vy xy) (* +ball-radius+ 2))) - (setf (v:vy vxy) (- (v:vy vxy)))))))) - -(defmethod on-update :after ((game game) timelapse) + ((minusp (- y +ball-radius+)) + (setf y (+ (- y) (* +ball-radius+ 2))) + (setf vy (- vy))) + ((> (+ y +ball-radius+) 1) + (setf y (- 2 y (* +ball-radius+ 2))) + (setf vy (- vy))))))) + +(defmethod on-update ((game game) timelapse) (let* ((state (game-state game)) (left-paddle (state-left-paddle state)) (right-paddle (state-right-paddle state)) @@ -154,17 +187,3 @@ (defmethod resume ((game game)) (setf (slot-value (game-state game) 'paused) nil)) -(defgeneric handle-action (game action)) - -(defmethod launch-ball ((ball ball) bounces rad x y) - (let* ((v (v:v* (v:vec (cos rad) (sin rad)) (* (log (+ bounces 2)) +ball-speed+)))) - (with-slots (xy vxy) ball - (setf xy (v:vec x y)) - (setf vxy v)))) - -(defmethod random-launch-ball ((state state)) - (launch-ball (state-ball state) - (setf (state-bounces state) 0) - (+ (random +max-launch-angle+) (* (random 2) pi)) - 0.5 - (random 1.0))) diff --git a/game/src/messages.lisp b/game/src/messages.lisp new file mode 100644 index 0000000..a91d278 --- /dev/null +++ b/game/src/messages.lisp @@ -0,0 +1,31 @@ +(in-package :pong.game) + +(defclass game-action-message () + ((game-code :initarg :game-code :initform nil :reader game-code) + (game-action :initarg :game-action :initform nil :reader game-action))) + +(defclass state-updated-message () + ((game-state :initarg :game-state :initform nil :reader game-state))) + +(defclass create-game-message () + ((player-name :initarg :player-name :initform nil :reader player-name))) + +(defclass join-game-message () + ((game-code :initarg :game-code :initform nil :reader game-code) + (player-name :initarg :player-name :initform nil :reader player-name))) + +(defclass game-created-message () + ((game-code :initarg :game-code :initform nil :reader game-code) + (player-paddle :initarg :player-paddle :initform nil :reader player-paddle) + (game-state :initarg :game-state :initform nil :reader game-state))) + +(defclass game-joined-message () + ((player-paddle :initarg :player-paddle :initform nil :reader player-paddle) + (game-state :initarg :game-state :initform nil :reader game-state))) + +(cpk:defencoding game-action-message game-code game-action) +(cpk:defencoding state-updated-message game-state) +(cpk:defencoding create-game-message player-name) +(cpk:defencoding join-game-message game-code player-name) +(cpk:defencoding game-created-message game-code player-paddle game-state) +(cpk:defencoding game-joined-message player-paddle game-state) diff --git a/game/src/package.lisp b/game/src/package.lisp index 8783a93..51b01e2 100644 --- a/game/src/package.lisp +++ b/game/src/package.lisp @@ -1,13 +1,15 @@ (defpackage :pong.game (:use :cl) (:local-nicknames (:v :3d-vectors)) + (:nicknames :g) (:export #:paddle #:ball #:state #:game + #:online-game #:on-update #:on-init - #:handle-action + #:on-quit #:launch-ball #:random-launch-ball #:game-state @@ -20,8 +22,11 @@ #:state-bounces #:state-left-player #:state-right-player - #:ball-xy - #:ball-vxy + #:actions + #:ball-x + #:ball-y + #:ball-vx + #:ball-vy #:paddle-y #:paddle-vy #:+paddle-speed+ @@ -30,13 +35,24 @@ #:+max-launch-angle+ #:+ball-radius+ #:action-timestamp - #:start-game-action + #:game-action #:start-down-action #:stop-down-action #:start-up-action #:stop-up-action + #:game-code #:apply-action #:name #:state-paused #:pause - #:resume)) + #:resume + #:game-action-message + #:state-updated-message + #:create-game-message + #:join-game-message + #:game-created-message + #:game-joined-message + #:game-code + #:game-action + #:player-name + #:player-paddle)) diff --git a/serializer.lisp b/serializer.lisp new file mode 100644 index 0000000..534f233 --- /dev/null +++ b/serializer.lisp @@ -0,0 +1,14 @@ +(defun print-object-readably (object) + (let ((slots (map 'list #'c2mop:slot-definition-name (c2mop:class-slots (class-of object)))) + (class (class-name (class-of object)))) + (cons class (remove-if #'null + (loop for slot in slots + collect (if (slot-boundp object slot) + (cons slot (slot-value object slot)))))))) + +(defun read-object (sexp) + (let* ((class (car sexp)) + (object (make-instance class))) + (loop for slot in (cdr sexp) + do (setf (slot-value object (car slot)) (cdr slot))) + object)) diff --git a/server/src/package.lisp b/server/src/package.lisp index da8abaa..15a516c 100644 --- a/server/src/package.lisp +++ b/server/src/package.lisp @@ -1,3 +1,3 @@ (defpackage :pong.server (:use :cl) - (:local-nicknames (:g :pong.game))) + (:nicknames :s)) diff --git a/server/src/server.lisp b/server/src/server.lisp index c33a6df..9ca7844 100644 --- a/server/src/server.lisp +++ b/server/src/server.lisp @@ -1,44 +1,63 @@ (in-package :pong.server) -(defclass online-game (game) - ((actions :initarg :actions - :initform nil))) +(defclass online-game (g:online-game) + ((lock :initarg :lock :initform (bt:make-lock) :reader online-game-lock) + (connections :initarg :connections :initform nil :accessor online-game-connections))) (defparameter *server* nil) (defparameter *server-running* nil) -(defparameter *connections* nil) -(defparameter *games* nil) -(defparameter *client-game-map* (make-hash-table)) + +(defparameter *connections* (make-hash-table)) +(defparameter *games* (make-hash-table :test 'equal)) + +(defun get-connections () + (loop for key being the hash-keys of *connections* collect key)) (defmacro loop-while-server-running (&body body) - `(loop while *server-running* - do (progn ,@body))) + `(loop while *server-running* do (progn ,@body))) (defun get-time () (/ (get-internal-real-time) internal-time-units-per-second)) (defun send-data-to-client (data client) (let ((stream (usocket:socket-stream client))) - (cpk:encode data :stream stream) - (force-output stream))) + (when stream + (cpk:encode data :stream stream) + (force-output stream)))) + +(defmacro send-message-to-client (client message &rest args) + `(send-data-to-client (make-instance ',message ,@args) ,client)) + +(defun update-game (game) + (bt:with-lock-held ((online-game-lock game)) + (let* ((actions (g:actions game)) + (connections (online-game-connections game)) + (state (g:game-state game)) + (last-time (g:state-timestamp state))) + (loop for action in (sort actions '< :key #'g:action-timestamp) + do (g:on-update game (- (g:action-timestamp action) last-time)) + (setf last-time (g:action-timestamp action)) + (g:apply-action action game)) + + (let ((current-time (get-time))) + (g:on-update game (- current-time last-time)) + (setf (g:state-timestamp state) current-time)) + + (setf (g:actions game) nil) + + (loop for con in connections + do (send-message-to-client con g:state-updated-message :game-state state))))) (defun update-games () - (let ((last-time nil) - (current-time (get-time))) - (loop-while-server-running - (setf last-time current-time) - (setf current-time (get-time)) - (let ((timelapse (- current-time last-time))) - (loop for client in *connections* - do (send-data-to-client "hello!" client))) - (sleep .100)))) + (loop-while-server-running + (loop for game being the hash-values of *games* + do (update-game game)) + (sleep .100))) (defun handle-client (client) (let* ((stream (usocket:socket-stream client)) - (msg (cpk:decode-stream stream))) - (format t "[SERVER] Message echoed: ~a~%" msg) - (cpk:encode msg :stream stream) - (force-output stream))) + (action (cpk:decode-stream stream))) + (handle-message action stream client))) (defun open-server-socket (port) (usocket:socket-listen "127.0.0.1" port :reuse-address t :element-type 'unsigned-byte)) @@ -48,7 +67,9 @@ (defun close-connection (connection) (usocket:socket-close connection) - (setf *connections* (remove connection *connections*))) + (let ((game (gethash connection *connections*))) + (when game (remhash (g:game-code game) *games*))) + (remhash connection *connections*)) (defun start-server (port) (unless *server-running* @@ -58,23 +79,65 @@ (let* ((server-socket (open-server-socket port))) (unwind-protect (loop-while-server-running - (loop for ready in (wait-for-sockets-ready (cons server-socket *connections*)) - while *server-running* - do (if (usocket:stream-server-usocket-p ready) - (push (usocket:socket-accept ready) *connections*) - (handler-case (handle-client ready) - (stream-error () - (format t "Socket closed?~%") - (close-connection ready)) - ;; (t () (close-connection ready)) - )))) - (loop for c in (cons server-socket *connections*) + (loop for ready in (wait-for-sockets-ready (cons server-socket (get-connections))) + while *server-running* + do (if (usocket:stream-server-usocket-p ready) + (setf (gethash (usocket:socket-accept ready) *connections*) nil) + (handler-case (handle-client ready) + (stream-error () + (format t "Socket closed?~%") + (close-connection ready)))))) + (loop for c in (cons server-socket (get-connections)) do (close-connection c)) (stop-server))))) (defun stop-server () + (setf *games* (make-hash-table :test 'equal)) (setf *server-running* nil)) +(defmethod handle-message (msg stream connection)) + +(defmethod handle-message ((msg g:game-action-message) stream connection) + (declare (ignore stream connection)) + (let ((game (gethash (g:game-code msg) *games*))) + (when game + (push (g:game-action msg) (g:actions game))))) + +(defmethod handle-message ((msg g:create-game-message) stream connection) + (let ((game (make-instance 'online-game + :state (make-instance 'g:state + :left-player (g:player-name msg))))) + (setf (gethash (g:game-code game) *games*) game) + (pushnew connection (online-game-connections game)) + (setf (gethash connection *connections*) game) + (let ((response (make-instance 'g:game-created-message + :game-code (g:game-code game) + :player-paddle :left + :game-state (g:game-state game)))) + (cpk:encode response :stream stream)) + (force-output stream))) + +(defmethod handle-message ((msg g:join-game-message) stream connection) + (let* ((game (gethash (g:game-code msg) *games*)) + (state (g:game-state game)) + (left-player (g:state-left-player state)) + (right-player (g:state-right-player state)) + (paddle (cond (left-player :right) (right-player :left))) + (player (g:player-name msg))) + (when (or (not left-player) (not right-player)) + (pushnew connection (online-game-connections game)) + + (case paddle + (:left (setf (g:state-left-player state) player)) + (:right (setf (g:state-right-player state) player))) + + (let ((response (make-instance 'g:game-joined-message + :player-paddle paddle + :game-state state))) + (loop for con in (online-game-connections game) + do (send-data-to-client response con)))))) + ;; (start-server 54321) ;; (stop-server) +