Pariatech
/
cl-pong
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

multiplayer works

master
Gabriel Pariat 2 years ago
parent
dfe58d69b4
commit
e41a5479ab
21 changed files with 540 additions and 222 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 4
      client/client.asd
  2. 83
      client/src/client.lisp
  3. 2
      client/src/create-online-game-scene.lisp
  4. 34
      client/src/game-scene.lisp
  5. 11
      client/src/gui/package.lisp
  6. 53
      client/src/gui/text-field.lisp
  7. 4
      client/src/gui/text.lisp
  8. 81
      client/src/join-online-game-scene.lisp
  9. 34
      client/src/local-game.lisp
  10. 2
      client/src/main-menu.lisp
  11. 7
      client/src/main.lisp
  12. 109
      client/src/online-game.lisp
  13. 3
      client/src/package.lisp
  14. 3
      game/game.asd
  15. 29
      game/src/action.lisp
  16. 97
      game/src/game.lisp
  17. 31
      game/src/messages.lisp
  18. 26
      game/src/package.lisp
  19. 14
      serializer.lisp
  20. 2
      server/src/package.lisp
  21. 133
      server/src/server.lisp

4
client/client.asd
Unescape View File

@ -21,10 +21,10 @@
(:file "line"))) (:file "line")))
(:file "utils") (:file "utils")
(:file "scene") (:file "scene")
(:file "client")
(:file "game-scene") (:file "game-scene")
(:file "local-game") (:file "local-game")
(:file "online-game") (:file "online-game")
(:file "main-menu") (:file "main-menu")
(:file "main"))) (:file "create-online-game-scene")
(:file "client")))

83
client/src/client.lisp
Unescape View File

@ -1,65 +1,24 @@
(in-package :pong.client) (in-package :pong.client)
(defparameter *client* nil) (defun main ()
(let* ((last-time nil)
(defclass client () (current-time (get-internal-real-time)))
((ip :initarg :ip :initform nil :reader client-ip) (r:with-window (800 600 "Pariatech's Pong")
(port :initarg :port :initform nil :reader client-port) (gui:with-gui
(running-p :initform nil :accessor client-running-p) (open-main-menu)
(socket :initform nil :accessor client-socket)))
(r:set-config-flags r:+flag-window-resizable+)
(defmethod listen-to ((self client)) (r:set-target-fps 60)
(with-slots (running-p socket) self (r:set-exit-key 0)
(when (and running-p (usocket:wait-for-input socket :timeout 5) running-p) (loop
(let ((data (cpk:decode-stream (usocket:socket-stream socket)))) until (or (r:window-should-close) (scene-should-close *scene*))
(format t "[CLIENT] Data received: ~a~%" data))))) do (setf last-time current-time)
(setf current-time (/ (get-internal-real-time) internal-time-units-per-second))
(defmethod start ((self client))
(with-slots (ip port running-p socket) self (let ((timelapse (- current-time last-time)))
(format t "uh?~%") (on-update *scene* timelapse))
(unless running-p (r:with-drawing
(setf running-p t) (r:clear-background r:+gray+)
(setf socket (usocket:socket-connect ip port :element-type 'unsigned-byte))))) (on-draw *scene*)
(r:draw-fps 20 20)))))))
(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)

2
client/src/create-online-game-scene.lisp
Unescape View File

@ -44,7 +44,7 @@
when (= key r:+key-backspace+) when (= key r:+key-backspace+)
do (setf name (str:substring 0 -1 name)) do (setf name (str:substring 0 -1 name))
when (= key r:+key-enter+) when (= key r:+key-enter+)
do (start-online-game) do (create-online-game name)
when (and (>= key 32) (<= key 96)) when (and (>= key 32) (<= key 96))
do (setf name (str:concat name (string (code-char key))))))) do (setf name (str:concat name (string (code-char key)))))))

34
client/src/game-scene.lisp
Unescape View File

@ -13,7 +13,8 @@
(quit-menu :initarg :quit-menu :initform nil :reader game-scene-quit-menu) (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-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-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) (defun open-game (game)
(let ((root-element (gui:make-rectangle :color r:+darkgray+ (let ((root-element (gui:make-rectangle :color r:+darkgray+
@ -67,7 +68,12 @@
:font +score-font+ :font +score-font+
:font-size +score-txt-size+ :font-size +score-txt-size+
:h-align :center :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 (gui:add-children quit-menu
quit-menu-text quit-menu-text
@ -83,7 +89,8 @@
ball ball
line line
left-player left-player
right-player) right-player
code)
(g:on-init game) (g:on-init game)
@ -100,7 +107,8 @@
:quit-menu quit-menu :quit-menu quit-menu
:quit-menu-text quit-menu-text :quit-menu-text quit-menu-text
:quit-menu-yes quit-menu-yes :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) (defun position-score (el direction)
(setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) +score-padding+))) (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)))) (setf (gui:x el) (gui:w (gui:parent el))))
(defun position-ball (ball 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))) (parent (gui:parent el)))
(setf (gui:w el) (* g:+ball-radius+ (gui:w parent) 2)) (setf (gui:w el) (* g:+ball-radius+ (gui:w parent) 2))
(setf (gui:h el) (* g:+ball-radius+ (gui:h 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:x el) (* ball-x (gui:w parent)))
(setf (gui:y el) (* (v:vy ball-xy) (gui:h parent))))) (setf (gui:y el) (* ball-y (gui:h parent)))))
(defun position-line (el) (defun position-line (el)
(setf (gui:x el) (floor (gui:w (gui:parent el)) 2)) (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:y no) (+ (gui:y text) (gui:h text) +score-padding+))
(setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +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) (defmethod on-update ((scene game-scene) timelapse)
(g:on-update (game-scene-game scene) timelapse) (g:on-update (game-scene-game scene) timelapse)
@ -155,10 +167,11 @@
(g:pause (game-scene-game scene)) (g:pause (game-scene-game scene))
(setf (gui:visible (game-scene-quit-menu scene)) t)) (setf (gui:visible (game-scene-quit-menu scene)) t))
(when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+) (when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+)
(g:on-quit (game-scene-game scene))
(open-main-menu))) (open-main-menu)))
(defmethod on-draw ((scene game-scene)) (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 scene
(let ((game-state (g:game-state game))) (let ((game-state (g:game-state game)))
(position-root root-element) (position-root root-element)
@ -173,4 +186,7 @@
(setf (gui:text left-player) (g:state-left-player game-state)) (setf (gui:text left-player) (g:state-left-player game-state))
(setf (gui:text right-player) (g:state-right-player game-state)) (setf (gui:text right-player) (g:state-right-player game-state))
(position-right-player right-player) (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))))

11
client/src/gui/package.lisp
Unescape View File

@ -35,4 +35,13 @@
#:make-text #:make-text
#:make-rectangle #:make-rectangle
#:make-line #:make-line
#:with-gui)) #:with-gui)
;; text-field.lisp
(:export #:text-field
#:focusp
#:border
#:border-color
#:border-thickness
#:cursor
#:padding
#:make-text-field))

53
client/src/gui/text-field.lisp
Unescape View File

@ -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))

4
client/src/gui/text.lisp
Unescape View File

@ -19,7 +19,7 @@
(defmethod draw ((text text)) (defmethod draw ((text text))
(with-slots (font font-size text screen-x screen-y color spacing visible) 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) (r:draw-text-ex (load-font font font-size)
text text
(v:vec (float screen-x) (float screen-y)) (v:vec (float screen-x) (float screen-y))
@ -29,7 +29,7 @@
(defmethod calculate-size ((txt text)) (defmethod calculate-size ((txt text))
(with-slots (w h font font-size text spacing) txt (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) (let ((size (r:measure-text-ex (load-font font font-size)
text text
(float font-size) (float font-size)

81
client/src/join-online-game-scene.lisp
Unescape View File

@ -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)))
)

34
client/src/local-game.lisp
Unescape View File

@ -34,8 +34,8 @@
(let* ((right-paddle (g:state-right-paddle state)) (let* ((right-paddle (g:state-right-paddle state))
(paddle-y (g:paddle-y right-paddle)) (paddle-y (g:paddle-y right-paddle))
(ball (g:state-ball state)) (ball (g:state-ball state))
(ball-xy (g:ball-xy ball)) (ball-x (g:ball-x ball))
(ball-y (v:vy ball-xy)) (ball-y (g:ball-y ball))
(paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2)))))) (paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2))))))
@ -59,9 +59,8 @@
(< py (+ ry rh)))) (< py (+ ry rh))))
(defun get-ball-paddle-collision (ball paddle paddle-x) (defun get-ball-paddle-collision (ball paddle paddle-x)
(let* ((ball-xy (g:ball-xy ball)) (let* ((ball-x (g:ball-x ball))
(ball-x (v:vx ball-xy)) (ball-y (g:ball-y ball))
(ball-y (v:vy ball-xy))
(paddle-y (g:paddle-y paddle))) (paddle-y (g:paddle-y paddle)))
(when (or (point-in-rect-p (- ball-x g:+ball-radius+) (when (or (point-in-rect-p (- ball-x g:+ball-radius+)
(- ball-y g:+ball-radius+) (- ball-y g:+ball-radius+)
@ -91,11 +90,10 @@
(defun handle-ball (state timelapse) (defun handle-ball (state timelapse)
(let* ((ball (g:state-ball state)) (let* ((ball (g:state-ball state))
(ball-xy (g:ball-xy ball)) (ball-x (g:ball-x ball))
(ball-x (v:vx ball-xy)) (ball-y (g:ball-y ball))
(ball-y (v:vy ball-xy)) (ball-vx (g:ball-vx ball))
(ball-vxy (g:ball-vxy ball)) (ball-vy (g:ball-vy ball))
(ball-vy (v:vy ball-vxy))
(left-paddle (g:state-left-paddle state)) (left-paddle (g:state-left-paddle state))
(right-paddle (g:state-right-paddle state)) (right-paddle (g:state-right-paddle state))
(ball-left-paddle-collision (ball-left-paddle-collision
@ -127,19 +125,19 @@
(incf (g:state-left-score state)) (incf (g:state-left-score state))
(g:random-launch-ball state)) (g:random-launch-ball state))
((< (- ball-y g:+ball-radius+) 0) ((< (- ball-y g:+ball-radius+) 0)
(setf (v:vy ball-xy) g:+ball-radius+) (setf (g:ball-y ball) g:+ball-radius+)
(setf (v:vy ball-vxy) (* -1 ball-vy))) (setf (g:ball-vy ball) (* -1 ball-vy)))
((> (+ ball-y g:+ball-radius+) 1) ((> (+ ball-y g:+ball-radius+) 1)
(setf (v:vy ball-xy) (- 1 g:+ball-radius+)) (setf (g:ball-y ball) (- 1 g:+ball-radius+))
(setf (v:vy ball-vxy) (* -1 ball-vy))) (setf (g:ball-vy ball) (* -1 ball-vy)))
(t (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) (defun computer-paddle-target (game)
(let* ((game-state (g:game-state game)) (let* ((game-state (g:game-state game))
(ball (g:state-ball game-state)) (ball (g:state-ball game-state)))
(ball-vxy (g:ball-vxy ball))) (if (plusp (g:ball-vx ball))
(if (plusp (v:vx ball-vxy))
(or (local-game-1p-computer-paddle-target game) (or (local-game-1p-computer-paddle-target game)
(setf (local-game-1p-computer-paddle-target game) (setf (local-game-1p-computer-paddle-target game)
(random g:+paddle-height+))) (random g:+paddle-height+)))

2
client/src/main-menu.lisp
Unescape View File

@ -76,7 +76,7 @@
:font-size +menu-font-size+ :font-size +menu-font-size+
:color +menu-text-color+ :color +menu-text-color+
:h-align :center) :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)) (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join))
(gui:h (menu-item-text online-join))) (gui:h (menu-item-text online-join)))
:h-align :center :h-align :center

7
client/src/main.lisp
Unescape View File

@ -1,12 +1,5 @@
(in-package :pong.client) (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 () (defun main ()
(let* ((last-time nil) (let* ((last-time nil)
(current-time (get-internal-real-time))) (current-time (get-internal-real-time)))

109
client/src/online-game.lisp
Unescape View File

@ -1,18 +1,78 @@
(in-package :pong.client) (in-package :pong.client)
(defclass online-game (g:game) (defparameter *socket* nil)
((actions :initarg :actions :initform nil :accessor online-game-actions) (defparameter *stream* nil)
(keyboard :initform (make-hash-table) :reader online-game-keyboard) (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))) (paddle :initarg :paddle :initform :left :reader online-game-paddle)))
(defun start-online-game (&optional (paddle :left)) (defun get-time ()
(set-scene (open-game (make-instance 'online-game :paddle paddle)))) (/ (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 () (defun join-online-game ()
(start-online-game :left)) (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)) (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) (defun is-first-key-down-p (key keyboard)
(and (r:is-key-down key) (not (gethash key keyboard)))) (and (r:is-key-down key) (not (gethash key keyboard))))
@ -23,33 +83,46 @@
(defun set-key-down (key keyboard) (defun set-key-down (key keyboard)
(setf (gethash key keyboard) (r:is-key-down key))) (setf (gethash key keyboard) (r:is-key-down key)))
(defmethod g:on-update ((game online-game) timelapse) (defun handle-action (action game)
(with-slots (actions keyboard paddle) 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) (when (or (is-first-key-down-p r:+key-s+ keyboard)
(is-first-key-down-p r:+key-down+ keyboard)) (is-first-key-down-p r:+key-down+ keyboard))
(set-key-down r:+key-s+ keyboard) (set-key-down r:+key-s+ keyboard)
(set-key-down r:+key-down+ keyboard) (set-key-down r:+key-down+ keyboard)
(let ((action (make-instance 'g:start-down-action :paddle paddle))) (let ((action (make-instance 'g:start-down-action :paddle paddle)))
(g:apply-action action game) (handle-action action game)))
(push action actions)))
(when (or (is-first-key-released-p r:+key-s+ keyboard) (when (or (is-first-key-released-p r:+key-s+ keyboard)
(is-first-key-released-p r:+key-down+ keyboard)) (is-first-key-released-p r:+key-down+ keyboard))
(set-key-down r:+key-s+ keyboard) (set-key-down r:+key-s+ keyboard)
(set-key-down r:+key-down+ keyboard) (set-key-down r:+key-down+ keyboard)
(let ((action (make-instance 'g:stop-down-action :paddle paddle))) (let ((action (make-instance 'g:stop-down-action :paddle paddle)))
(g:apply-action action game) (handle-action action game)))
(push action action)))
(when (or (is-first-key-down-p r:+key-w+ keyboard) (when (or (is-first-key-down-p r:+key-w+ keyboard)
(is-first-key-down-p r:+key-up+ keyboard)) (is-first-key-down-p r:+key-up+ keyboard))
(set-key-down r:+key-w+ keyboard) (set-key-down r:+key-w+ keyboard)
(set-key-down r:+key-up+ keyboard) (set-key-down r:+key-up+ keyboard)
(let ((action (make-instance 'g:start-up-action :paddle paddle))) (let ((action (make-instance 'g:start-up-action :paddle paddle)))
(g:apply-action action game) (handle-action action game)))
(push action actions)))
(when (or (is-first-key-released-p r:+key-w+ keyboard) (when (or (is-first-key-released-p r:+key-w+ keyboard)
(is-first-key-released-p r:+key-up+ keyboard)) (is-first-key-released-p r:+key-up+ keyboard))
(set-key-down r:+key-w+ keyboard) (set-key-down r:+key-w+ keyboard)
(set-key-down r:+key-up+ keyboard) (set-key-down r:+key-up+ keyboard)
(let ((action (make-instance 'g:stop-up-action :paddle paddle))) (let ((action (make-instance 'g:stop-up-action :paddle paddle)))
(g:apply-action action game) (handle-action action game)))))
(push action actions)))))
(defmethod g:on-quit ((game online-game))
(usocket:socket-close *socket*)
(setf *socket* nil)
(setf *stream* nil)
(setf *game* nil))

3
client/src/package.lisp
Unescape View File

@ -1,5 +1,4 @@
(defpackage :pong.client (defpackage :pong.client
(:use :cl) (:use :cl)
(:local-nicknames (:r :raylib) (:local-nicknames (:r :raylib)
(:v :3d-vectors) (:v :3d-vectors)))
(:g :pong.game)))

3
game/game.asd
Unescape View File

@ -11,5 +11,6 @@
:components :components
((:file "package") ((:file "package")
(:file "game") (:file "game")
(:file "action"))) (:file "action")
(:file "messages")))

29
game/src/action.lisp
Unescape View File

@ -3,31 +3,24 @@
(defclass action () (defclass action ()
((timestamp :initarg :timestamp ((timestamp :initarg :timestamp
:initform (/ (get-internal-real-time) internal-time-units-per-second) :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)) (defgeneric apply-action (action game))
(defclass start-game-action (action) (defclass start-down-action (action) ())
((name :initarg :name :initform nil :accessor name)))
(defclass start-down-action (action) (defclass stop-down-action (action) ())
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass stop-down-action (action) (defclass start-up-action (action) ())
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass start-up-action (action) (defclass stop-up-action (action) ())
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass stop-up-action (action) (cpk:defencoding action timestamp paddle)
((paddle :initarg :paddle :initform nil :reader paddle))) (cpk:defencoding start-down-action timestamp paddle)
(cpk:defencoding stop-down-action timestamp paddle)
(cpk:defencoding action timestamp) (cpk:defencoding start-up-action timestamp paddle)
(cpk:defencoding start-game-action name) (cpk:defencoding stop-up-action timestamp paddle)
(cpk:defencoding start-down-action paddle)
(cpk:defencoding stop-down-action paddle)
(cpk:defencoding start-up-action paddle)
(cpk:defencoding stop-up-action paddle)
(defun get-paddle (paddle state) (defun get-paddle (paddle state)
(case paddle (case paddle

97
game/src/game.lisp
Unescape View File

@ -12,13 +12,15 @@
(vy 0.0 :type float)) (vy 0.0 :type float))
(defstruct ball (defstruct ball
(xy (make-instance 'v:vec2) :type v:vec2) (x 0.0 :type float)
(vxy (make-instance 'v:vec2) :type v:vec2)) (y 0.0 :type float)
(vx 0.0 :type float)
(vy 0.0 :type float))
(defclass state () (defclass state ()
((timestamp :initarg :timestamp ((timestamp :initarg :timestamp
:initform (/ (get-internal-real-time) internal-time-units-per-second) :initform (/ (get-internal-real-time) internal-time-units-per-second)
:reader state-timestamp) :accessor state-timestamp)
(left-paddle :initarg :left-paddle (left-paddle :initarg :left-paddle
:initform (make-paddle :y 0.5) :initform (make-paddle :y 0.5)
:accessor state-left-paddle) :accessor state-left-paddle)
@ -26,7 +28,7 @@
:initform (make-paddle :y 0.5) :initform (make-paddle :y 0.5)
:accessor state-right-paddle) :accessor state-right-paddle)
(ball :initarg :ball (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) :accessor state-ball)
(bounces :initarg :bounces (bounces :initarg :bounces
:initform 0 :initform 0
@ -38,22 +40,40 @@
:initform 0 :initform 0
:accessor state-right-score) :accessor state-right-score)
(left-player :initarg :left-player (left-player :initarg :left-player
:initform "You" :initform nil
:accessor state-left-player) :accessor state-left-player)
(right-player :initarg :right-player (right-player :initarg :right-player
:initform "Opponent" :initform nil
:accessor state-right-player) :accessor state-right-player)
(paused :initarg :paused (paused :initarg :paused
:initform nil :initform nil
:reader state-paused))) :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 () (defclass game ()
((state :initarg :game-state ((state :initarg :state
:initform (make-instance 'state) :initform (make-instance 'state)
:accessor game-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-update (game timelapse))
(defgeneric on-init (game)) (defgeneric on-init (game))
(defgeneric on-quit (game))
(defun update-paddle (paddle timelapse) (defun update-paddle (paddle timelapse)
(setf (paddle-y paddle) (setf (paddle-y paddle)
@ -68,9 +88,8 @@
(< py (+ ry rh)))) (< py (+ ry rh))))
(defun get-ball-paddle-collision (ball paddle paddle-x) (defun get-ball-paddle-collision (ball paddle paddle-x)
(let* ((ball-xy (ball-xy ball)) (let* ((ball-x (ball-x ball))
(ball-x (v:vx ball-xy)) (ball-y (ball-y ball))
(ball-y (v:vy ball-xy))
(paddle-y (paddle-y paddle))) (paddle-y (paddle-y paddle)))
(when (or (point-in-rect-p (- ball-x +ball-radius+) (when (or (point-in-rect-p (- ball-x +ball-radius+)
(- ball-y +ball-radius+) (- ball-y +ball-radius+)
@ -98,10 +117,24 @@
+paddle-height+)) +paddle-height+))
(- ball-y paddle-y)))) (- 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) (defun update-ball (state ball left-paddle right-paddle timelapse)
(with-slots (xy vxy) ball (with-slots (x y vx vy) ball
(incf (v:vx xy) (* (v:vx vxy) timelapse)) (incf x (* vx timelapse))
(incf (v:vy xy) (* (v:vy vxy) timelapse)) (incf y (* vy timelapse))
(let ((ball-left-paddle-collision (let ((ball-left-paddle-collision
(get-ball-paddle-collision ball left-paddle 0.0)) (get-ball-paddle-collision ball left-paddle 0.0))
(ball-right-paddle-collision (ball-right-paddle-collision
@ -114,7 +147,7 @@
(+ (/ +paddle-height+ 2) +ball-radius+)) (+ (/ +paddle-height+ 2) +ball-radius+))
+max-launch-angle+) +max-launch-angle+)
(+ +paddle-width+ +ball-radius+) (+ +paddle-width+ +ball-radius+)
(v:vy xy))) y))
(ball-right-paddle-collision (ball-right-paddle-collision
(launch-ball ball (launch-ball ball
(incf (state-bounces state)) (incf (state-bounces state))
@ -123,21 +156,21 @@
(+ (/ +paddle-height+ 2) +ball-radius+)) (+ (/ +paddle-height+ 2) +ball-radius+))
(/ +max-launch-angle+ 2))) (/ +max-launch-angle+ 2)))
(- 1.0 +paddle-width+ +ball-radius+) (- 1.0 +paddle-width+ +ball-radius+)
(v:vy xy))) y))
((minusp (+ (v:vx xy) +ball-radius+)) ((minusp (+ x +ball-radius+))
(incf (state-right-score state)) (incf (state-right-score state))
(random-launch-ball state)) (random-launch-ball state))
((> (- (v:vx xy) +ball-radius+) 1) ((> (- x +ball-radius+) 1)
(incf (state-left-score state)) (incf (state-left-score state))
(random-launch-ball state)) (random-launch-ball state))
((minusp (- (v:vy xy) +ball-radius+)) ((minusp (- y +ball-radius+))
(setf (v:vy xy) (+ (- (v:vy xy)) (* +ball-radius+ 2))) (setf y (+ (- y) (* +ball-radius+ 2)))
(setf (v:vy vxy) (- (v:vy vxy)))) (setf vy (- vy)))
((> (+ (v:vy xy) +ball-radius+) 1) ((> (+ y +ball-radius+) 1)
(setf (v:vy xy) (- 2 (v:vy xy) (* +ball-radius+ 2))) (setf y (- 2 y (* +ball-radius+ 2)))
(setf (v:vy vxy) (- (v:vy vxy)))))))) (setf vy (- vy)))))))
(defmethod on-update :after ((game game) timelapse) (defmethod on-update ((game game) timelapse)
(let* ((state (game-state game)) (let* ((state (game-state game))
(left-paddle (state-left-paddle state)) (left-paddle (state-left-paddle state))
(right-paddle (state-right-paddle state)) (right-paddle (state-right-paddle state))
@ -154,17 +187,3 @@
(defmethod resume ((game game)) (defmethod resume ((game game))
(setf (slot-value (game-state game) 'paused) nil)) (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)))

31
game/src/messages.lisp
Unescape View File

@ -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)

26
game/src/package.lisp
Unescape View File

@ -1,13 +1,15 @@
(defpackage :pong.game (defpackage :pong.game
(:use :cl) (:use :cl)
(:local-nicknames (:v :3d-vectors)) (:local-nicknames (:v :3d-vectors))
(:nicknames :g)
(:export #:paddle (:export #:paddle
#:ball #:ball
#:state #:state
#:game #:game
#:online-game
#:on-update #:on-update
#:on-init #:on-init
#:handle-action #:on-quit
#:launch-ball #:launch-ball
#:random-launch-ball #:random-launch-ball
#:game-state #:game-state
@ -20,8 +22,11 @@
#:state-bounces #:state-bounces
#:state-left-player #:state-left-player
#:state-right-player #:state-right-player
#:ball-xy #:actions
#:ball-vxy #:ball-x
#:ball-y
#:ball-vx
#:ball-vy
#:paddle-y #:paddle-y
#:paddle-vy #:paddle-vy
#:+paddle-speed+ #:+paddle-speed+
@ -30,13 +35,24 @@
#:+max-launch-angle+ #:+max-launch-angle+
#:+ball-radius+ #:+ball-radius+
#:action-timestamp #:action-timestamp
#:start-game-action #:game-action
#:start-down-action #:start-down-action
#:stop-down-action #:stop-down-action
#:start-up-action #:start-up-action
#:stop-up-action #:stop-up-action
#:game-code
#:apply-action #:apply-action
#:name #:name
#:state-paused #:state-paused
#:pause #: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))

14
serializer.lisp
Unescape View File

@ -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))

2
server/src/package.lisp
Unescape View File

@ -1,3 +1,3 @@
(defpackage :pong.server (defpackage :pong.server
(:use :cl) (:use :cl)
(:local-nicknames (:g :pong.game))) (:nicknames :s))

133
server/src/server.lisp
Unescape View File

@ -1,44 +1,63 @@
(in-package :pong.server) (in-package :pong.server)
(defclass online-game (game) (defclass online-game (g:online-game)
((actions :initarg :actions ((lock :initarg :lock :initform (bt:make-lock) :reader online-game-lock)
:initform nil))) (connections :initarg :connections :initform nil :accessor online-game-connections)))
(defparameter *server* nil) (defparameter *server* nil)
(defparameter *server-running* nil) (defparameter *server-running* nil)
(defparameter *connections* nil)
(defparameter *games* nil) (defparameter *connections* (make-hash-table))
(defparameter *client-game-map* (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) (defmacro loop-while-server-running (&body body)
`(loop while *server-running* `(loop while *server-running* do (progn ,@body)))
do (progn ,@body)))
(defun get-time () (defun get-time ()
(/ (get-internal-real-time) internal-time-units-per-second)) (/ (get-internal-real-time) internal-time-units-per-second))
(defun send-data-to-client (data client) (defun send-data-to-client (data client)
(let ((stream (usocket:socket-stream client))) (let ((stream (usocket:socket-stream client)))
(cpk:encode data :stream stream) (when stream
(force-output 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 () (defun update-games ()
(let ((last-time nil) (loop-while-server-running
(current-time (get-time))) (loop for game being the hash-values of *games*
(loop-while-server-running do (update-game game))
(setf last-time current-time) (sleep .100)))
(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))))
(defun handle-client (client) (defun handle-client (client)
(let* ((stream (usocket:socket-stream client)) (let* ((stream (usocket:socket-stream client))
(msg (cpk:decode-stream stream))) (action (cpk:decode-stream stream)))
(format t "[SERVER] Message echoed: ~a~%" msg) (handle-message action stream client)))
(cpk:encode msg :stream stream)
(force-output stream)))
(defun open-server-socket (port) (defun open-server-socket (port)
(usocket:socket-listen "127.0.0.1" port :reuse-address t :element-type 'unsigned-byte)) (usocket:socket-listen "127.0.0.1" port :reuse-address t :element-type 'unsigned-byte))
@ -48,7 +67,9 @@
(defun close-connection (connection) (defun close-connection (connection)
(usocket:socket-close 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) (defun start-server (port)
(unless *server-running* (unless *server-running*
@ -58,23 +79,65 @@
(let* ((server-socket (open-server-socket port))) (let* ((server-socket (open-server-socket port)))
(unwind-protect (unwind-protect
(loop-while-server-running (loop-while-server-running
(loop for ready in (wait-for-sockets-ready (cons server-socket *connections*)) (loop for ready in (wait-for-sockets-ready (cons server-socket (get-connections)))
while *server-running* while *server-running*
do (if (usocket:stream-server-usocket-p ready) do (if (usocket:stream-server-usocket-p ready)
(push (usocket:socket-accept ready) *connections*) (setf (gethash (usocket:socket-accept ready) *connections*) nil)
(handler-case (handle-client ready) (handler-case (handle-client ready)
(stream-error () (stream-error ()
(format t "Socket closed?~%") (format t "Socket closed?~%")
(close-connection ready)) (close-connection ready))))))
;; (t () (close-connection ready)) (loop for c in (cons server-socket (get-connections))
))))
(loop for c in (cons server-socket *connections*)
do (close-connection c)) do (close-connection c))
(stop-server))))) (stop-server)))))
(defun stop-server () (defun stop-server ()
(setf *games* (make-hash-table :test 'equal))
(setf *server-running* nil)) (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) ;; (start-server 54321)
;; (stop-server) ;; (stop-server)

Write Preview
Loading…
Cancel
Save