multiplayer works

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

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

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

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

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

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

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)

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

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

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

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

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

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

game/game.asd

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

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

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

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)

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

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

server/src/package.lisp

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

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