online finished

client/client.asd

@@ -18,13 +18,15 @@
 		 (:file "element")
 		 (:file "rectangle")
 		 (:file "text")
-		 (:file "line")))
+		 (:file "line")
+		 (:file "text-field")))
    (:file "utils")
    (:file "scene")
    (:file "game-scene")
    (:file "local-game")
    (:file "online-game")
-   (:file "main-menu")
+   (:file "join-online-game-scene")
    (:file "create-online-game-scene")
+   (:file "main-menu")
    (:file "client")))
 

client/src/client.lisp

@@ -2,7 +2,7 @@
 
 (defun main ()
   (let* ((last-time nil)
-	 (current-time (get-internal-real-time)))
+	 (current-time (g:get-time)))
     (r:with-window (800 600 "Pariatech's Pong")
       (gui:with-gui
 	(open-main-menu)
@@ -13,7 +13,7 @@
 	(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))
+	     (setf current-time (g:get-time))
 	     
 	     (let ((timelapse (- current-time last-time)))
 	       (on-update *scene* timelapse))

client/src/constants.lisp

@@ -1,17 +1,17 @@
 (in-package :pong.client)
 
-(defconstant +title-top-padding+ 30)
+(defparameter *title-top-padding* 30)
-(defconstant +menu-padding+ 10)
+(defparameter *menu-padding* 10)
-(defconstant +menu-group-padding+ 20)
+(defparameter *menu-group-padding* 20)
-(defconstant +menu-font+ "assets/ComicMono.ttf")
+(defparameter *menu-font* "client/assets/ComicMono.ttf")
-(defconstant +menu-font-size+ 32)
+(defparameter *menu-font-size* 32)
-(defconstant +menu-title-font-size+ 52)
+(defparameter *menu-title-font-size* 52)
-(defconstant +menu-group-title-font-size+ 42)
+(defparameter *menu-group-title-font-size* 42)
-(defconstant +menu-text-color+ r:+white+)
+(defparameter *menu-text-color* r:+white+)
-(defconstant +menu-local-1-player+ "1 Player")
+(defparameter *menu-local-1-player* "1 Player")
-(defconstant +menu-local-2-players+ "2 Players")
+(defparameter *menu-local-2-players* "2 Players")
-(defconstant +menu-online-create+ "Create Game")
+(defparameter *menu-online-create* "Create Game")
-(defconstant +menu-online-join+ "Join Game")
+(defparameter *menu-online-join* "Join Game")
-(defconstant +score-txt-size+ 32)
+(defparameter *score-txt-size* 32)
-(defconstant +score-padding+ 20)
+(defparameter *score-padding* 20)
-(defconstant +score-font+ "assets/ComicMono.ttf")
+(defparameter *score-font* "client/assets/ComicMono.ttf")

client/src/create-online-game-scene.lisp

@@ -11,18 +11,18 @@
 					  :h-align :center
 					  :v-align :middle))
 	(title (gui:make-text :color r:+white+
-			      :font +menu-font+
+			      :font *menu-font*
-			      :font-size +menu-title-font-size+
+			      :font-size *menu-title-font-size*
-			      :y +title-top-padding+
+			      :y *title-top-padding*
 			      :h-align :center
 			      :text "Create online game"))
 	(name-field (gui:make-text :color r:+white+
-				   :font +menu-font+
+				   :font *menu-font*
-				   :font-size +menu-font-size+
+				   :font-size *menu-font-size*
 				   :v-align :middle))
 	(prompt (gui:make-text :color r:+white+
-			       :font +menu-font+
+			       :font *menu-font*
-			       :font-size +menu-font-size+
+			       :font-size *menu-font-size*
 			       :h-align :right
 			       :v-align :middle
 			       :text "What is your name?:")))
@@ -38,7 +38,6 @@
     ;; 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+)
@@ -53,7 +52,7 @@
     (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-field) (+ (floor (gui:w root-element) 2) *score-padding*))
-    (setf (gui:x prompt) (- (floor (gui:w root-element) 2) +score-padding+))
+    (setf (gui:x prompt) (- (floor (gui:w root-element) 2) *score-padding*))
     (setf (gui:y name-field) (floor (gui:h root-element) 2))
     (setf (gui:y prompt) (floor (gui:h root-element) 2))))

client/src/game-scene.lisp

@@ -14,36 +14,38 @@
    (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)
-   (code :initarg :code :initform nil :reader game-scene-code)))
+   (code :initarg :code :initform nil :reader game-scene-code)
+   (popup :initarg :popup :initform nil :reader game-scene-popup)
+   (popup-text :initarg :popup-text :initform nil :reader game-scene-popup-text)))
 
 (defun open-game (game)
   (let ((root-element (gui:make-rectangle :color r:+darkgray+
 					  :h-align :center
 					  :v-align :middle))
 	(left-score (gui:make-text        :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
 				          :h-align :right
-					  :y +score-padding+))
+					  :y *score-padding*))
 	(right-score (gui:make-text       :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
-					  :y +score-padding+))
+					  :y *score-padding*))
 	(left-paddle (gui:make-rectangle  :color r:+white+
 					  :v-align :middle))
 	(right-paddle (gui:make-rectangle :color r:+white+
 					  :h-align :right
 					  :v-align :middle))
 	(left-player (gui:make-text       :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
-					  :x +score-padding+
+					  :x *score-padding*
-					  :y +score-padding+))
+					  :y *score-padding*))
 	(right-player (gui:make-text      :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
 					  :h-align :right
-					  :y +score-padding+))
+					  :y *score-padding*))
 	(ball (gui:make-rectangle         :color r:+white+
 					  :h-align :center
 					  :v-align :middle))
@@ -54,34 +56,47 @@
 					  :v-align :middle
 					  :visible nil))
 	(quit-menu-text (gui:make-text    :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
-					  :y +score-padding+
+					  :y *score-padding*
 					  :h-align :center
 					  :text "Do you really want to quit the game?"))
 	(quit-menu-yes (gui:make-text     :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
 					  :h-align :center
 					  :text "Yes"))
 	(quit-menu-no (gui:make-text      :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
 					  :h-align :center
 					  :text "No"))
 	(code (gui:make-text              :color r:+white+
-					  :font +score-font+
+					  :font *score-font*
-					  :font-size +score-txt-size+
+					  :font-size *score-txt-size*
-					  :x +score-padding+
+					  :x *score-padding*
-					  :v-align :bottom)))
+					  :v-align :bottom))
+	(popup (gui:make-rectangle        :color r:+black+
+					  :h-align :center
+					  :v-align :middle
+					  :visible nil))
+	(popup-text (gui:make-text        :color r:+white+
+					  :font *score-font*
+					  :font-size *score-txt-size*
+					  :y *score-padding*
+					  :x *score-padding*
+					  :text "Waiting for opponent...")))
 
     (gui:add-children quit-menu
 		      quit-menu-text
 		      quit-menu-yes
 		      quit-menu-no)
 
+    (gui:add-children popup popup-text)
+
     (gui:add-children root-element
 		      quit-menu
+		      popup
 		      left-score
 		      right-score
 		      left-paddle
@@ -108,10 +123,12 @@
 			       :quit-menu-text quit-menu-text
 			       :quit-menu-yes quit-menu-yes
 			       :quit-menu-no quit-menu-no
-			       :code code)))
+			       :code code
+			       :popup popup
+			       :popup-text popup-text)))
 
 (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*)))
 
 (defun position-paddle (paddle el)
   (let ((paddle-y (g:paddle-y paddle))
@@ -139,21 +156,27 @@
   (setf (gui:end-y el) (gui:h (gui:parent el))))
 
 (defun position-right-player (el)
-  (setf (gui:x el) (- (gui:w (gui:parent el)) +score-padding+)))
+  (setf (gui:x el) (- (gui:w (gui:parent el)) *score-padding*)))
 
 (defun position-quit-menu (menu text yes no)
   (setf (gui:x menu) (floor (gui:w (gui:parent menu)) 2))
   (setf (gui:y menu) (floor (gui:h (gui:parent menu)) 2))
-  (setf (gui:w menu) (+ (gui:w text) (* +score-padding+ 2)))
+  (setf (gui:w menu) (+ (gui:w text) (* *score-padding* 2)))
   (setf (gui:x text) (floor (gui:w menu) 2))
   (setf (gui:x yes) (floor (gui:w menu) 3))
   (setf (gui:x no) (floor (gui:w menu) 3/2))
-  (setf (gui:y yes) (+ (gui:y text) (gui:h text) +score-padding+))
+  (setf (gui:y yes) (+ (gui:y text) (gui:h text) *score-padding*))
-  (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-popup (popup text)
+  (setf (gui:x popup) (floor (gui:w (gui:parent popup)) 2))
+  (setf (gui:y popup) (floor (gui:h (gui:parent popup)) 2))
+  (setf (gui:w popup) (+ (gui:w text) (* *score-padding* 2)))
+  (setf (gui:h popup) (+ (gui:h text) (* *score-padding* 2))))
 
 (defun position-code (el)
-  (setf (gui:y el) (- (gui:h (gui:parent el)) +score-padding+)))
+  (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)
@@ -171,7 +194,7 @@
     (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 code)
+  (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 popup popup-text)
       scene
     (let ((game-state (g:game-state game)))
       (position-root root-element)
@@ -189,4 +212,5 @@
       (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))))
+      (position-code code)
+      (position-popup popup popup-text))))

client/src/gui/package.lisp

@@ -44,4 +44,5 @@
 	   #:border-thickness
 	   #:cursor
 	   #:padding
-	   #:make-text-field))
+	   #:make-text-field
+	   ))

client/src/gui/text-field.lisp

@@ -6,17 +6,23 @@
    (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)))
+   (padding          :initarg :padding          :initform 0         :accessor padding)
+   (min-width        :initarg :min-width        :initform 0         :accessor min-width)))
 
 (defmethod calculate-size ((txt text-field))
-  (with-slots (w h font font-size text spacing padding) txt
+  (with-slots (w h font font-size text spacing padding min-width) txt
-    (when (and font text)
+    (when font
       (let ((size (r:measure-text-ex (load-font font font-size)
-				     text
+				     (or text "")
 				     (float font-size)
 				     spacing)))
-	(setf w (+ (v:vx size) (* padding 2)))
+	(setf w (max min-width (+ (v:vx size) (* padding 2))))
-	(setf h (+ (v:vy size) (* padding 2)))
+	(setf h (+ (max (v:vy (r:measure-text-ex (load-font font font-size)
+					      " "
+					      (float font-size)
+					      spacing))
+			(v:vy size))
+		   (* padding 2)))
 	(update-x txt)
 	(update-y txt)))))
 
@@ -31,15 +37,16 @@
 				   (float border-thickness)
 				   border-color))
       (when focusp
-	(r:draw-line-e)
+	(let ((size (r:measure-text-ex (load-font font font-size)
-	(r:draw-text-ex (load-font font font-size)
+				       (str:substring 0 cursor text)
-			(concatenate 'string
-				     (str:repeat cursor " ")
-				     (string #\left_one_eighth_block))
-			(v:vec (float (+ screen-x padding)) (float (+ screen-y padding)))
 				       (float font-size)
-			spacing
+				       spacing)))
-			color))
+	  (r:draw-line-ex (v:vec2 (+ screen-x padding (v:vx size))
+				  (+ screen-y padding))
+			  (v:vec2 (+ screen-x padding (v:vx size))
+				  (+ screen-y padding (v:vy size)))
+			  1.0
+			  color)))
       (when text
 	(r:draw-text-ex (load-font font font-size)
 			text
@@ -49,5 +56,5 @@
 			color)))))
 
 (defmacro make-text-field (&rest args)
-  `(make-instance 'text-field ,@args))
+  `(update (make-instance 'text-field ,@args)))
 

client/src/join-online-game-scene.lisp

@@ -18,64 +18,165 @@
 		:reader join-online-game-scene-code-prompt)
    (join-button :initarg :join-button
 		:initform nil
-		:reader join-online-game-scene-join-button)))
+		:reader join-online-game-scene-join-button)
+   (items-group :initarg :items-group
+		:initform nil
+		:reader join-online-game-scene-items-group)
+   (popup :initarg :popup :initform nil :reader join-online-game-scene-popup)
+   (popup-text :initarg :popup-text :initform nil :reader join-online-game-scene-popup-text)))
 
 (defun open-join-online-game-scene ()
-  (let ((root-element (gui:make-rectangle :color r:+darkgray+
+  (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 *menu-font*
-			      :font-size +menu-title-font-size+
+			       :font-size *menu-title-font-size*
-			      :y +title-top-padding+
+			       :y *title-top-padding*
 			       :h-align :center
 			       :text "Join online game"))
-	(name-field (gui:make-text-field :color r:+white+
+	 (name-field (gui:make-text-field :y 0
-					 :font +menu-font+
+					  :color r:+white+
-					 :font-size +menu-font-size+
+					  :font *menu-font*
+					  :font-size *menu-font-size*
 					  :focusp t
 					  :border :solid
 					  :border-color r:+white+
 					  :border-thickness 1
 					  :cursor 0
-					 :padding 5))
+					  :v-align :middle
-	(name-prompt (gui:make-text :color r:+white+
+					  :padding 10
-				    :font +menu-font+
+					  :min-width 150))
-				    :font-size +menu-font-size+
+	 (name-prompt (gui:make-text :y 0
+				     :color r:+white+
+				     :font *menu-font*
+				     :font-size *menu-font-size*
+				     :h-align :right
+				     :v-align :middle
+				     :text "What is your name?:"))
+	 (code-field (gui:make-text-field :y (+ (gui:h name-field) *menu-padding*)
+					  :color r:+white+
+					  :font *menu-font*
+					  :font-size *menu-font-size*
+					  :focusp nil
+					  :border :solid
+					  :border-color r:+white+
+					  :border-thickness 1
+					  :cursor 0
+					  :v-align :middle
+					  :padding 10
+					  :min-width 150))
+	 (code-prompt (gui:make-text :y (+ (gui:h name-field) *menu-padding*)
+				     :color r:+white+
+				     :font *menu-font*
+				     :font-size *menu-font-size*
 				     :h-align :right
 				     :v-align :middle
-				    :text "What is your name?:")))
+				     :text "What is the game code?:"))
+	 (join-button-text (gui:make-text :x (* *menu-padding* 2)
+					  :y (* *menu-padding* 2)
+					  :color r:+darkgray+
+					  :font *menu-font*
+					  :font-size *menu-font-size*
+					  :text "Join game"))
+	 (join-button (gui:make-rectangle :y (+ (gui:y code-field)
+						(gui:h code-field)
+						*menu-padding*)
+					  :w (+ (gui:w join-button-text) (* *menu-padding* 4))
+					  :h (+ (gui:h join-button-text) (* *menu-padding* 4))
+					  :h-align :middle
+					  :color r:+white+))
+	 (items-group (gui:make-element :h (+ (gui:y join-button) (gui:h join-button))
+					:h-align :center
+					:v-align :middle))
+	 (popup (gui:make-rectangle       :color r:+black+
+					  :h-align :center
+					  :v-align :middle
+					  :visible nil))
+	 (popup-text (gui:make-text        :color r:+white+
+					   :font *score-font*
+					   :font-size *score-txt-size*
+					   :y *score-padding*
+					   :x *score-padding*)))
 
-    (gui:add-children root-element title name-field name-prompt)
+    (gui:add-children popup popup-text)
+    (gui:add-children join-button join-button-text)
+    (gui:add-children items-group name-field name-prompt code-field code-prompt join-button)
+    (gui:add-children root-element title popup items-group)
     
     (set-scene (make-instance 'join-online-game-scene :root-element root-element
 						      :title title
 						      :name-field name-field
-						      :name-prompt name-prompt))))
+						      :name-prompt name-prompt
+						      :code-field code-field
+						      :code-prompt code-prompt
+						      :join-button join-button
+						      :items-group items-group
+						      :popup popup
+						      :popup-text popup-text))))
 
 (defmethod on-update ((scene join-online-game-scene) timelapse)
-  (with-slots (name move-back) scene
+  (with-slots (name code move-back name-field code-field join-button) scene
     ;; Might be interesting to add repeating keys, but I don't care.
+    (when (and (gui:clickedp name-field r:+mouse-button-left+)
+	       (not (gui:focusp name-field)))
+      (setf (gui:focusp name-field) t)
+      (setf (gui:focusp code-field) nil))
+
+    (when (and (gui:clickedp code-field r:+mouse-button-left+)
+	       (not (gui:focusp code-field)))
+      (setf (gui:focusp code-field) t)
+      (setf (gui:focusp name-field) nil))
+
     (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))
+	    do (cond ((gui:focusp name-field)
-	  ;; when (= key r:+key-enter+)
+		      (setf (gui:cursor name-field)
-	  ;;   do (create-online-game name)
+			    (max 0 (1- (gui:cursor name-field))))
+		      (setf name (str:substring 0 -1 name)))
+		     ((gui:focusp code-field)
+		      (setf (gui:cursor code-field)
+			    (max 0 (1- (gui:cursor code-field))))
+		      (setf code (str:substring 0 -1 code))))
 	  when (and (>= key 32) (<= key 96))
-	    do (setf name (str:concat name (string (code-char key))))))
+	    do (cond ((gui:focusp name-field)
-  )
+		      (incf (gui:cursor name-field))
+		      (setf name (str:concat name (string (code-char key)))))
+		     ((gui:focusp code-field)
+		      (incf (gui:cursor code-field))
+		      (setf code (str:concat code (string (code-char key)))))))
+
+    (when (gui:clickedp join-button r:+mouse-button-left+)
+      (case (join-online-game name code)
+	(:game-full
+	 (setf (gui:visible (join-online-game-scene-popup scene)) t)
+	 (setf (gui:text (join-online-game-scene-popup-text scene)) "The game is full."))
+	(:game-does-not-exist
+	 (setf (gui:visible (join-online-game-scene-popup scene)) t)
+	 (setf (gui:text (join-online-game-scene-popup-text scene)) "The game doesn't exist."))))))
 
 (defmethod on-draw ((scene join-online-game-scene))
-  (with-slots (name code root-element title name-field name-prompt) scene
+  (with-slots (name code root-element title name-field name-prompt code-field code-prompt join-button items-group popup popup-text) 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:text code-field) code)
-    (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:x items-group) (floor (gui:w root-element) 2))
-    (setf (gui:y name-prompt) (floor (gui:h root-element) 2)))
+    (setf (gui:y items-group) (floor (gui:h root-element) 2))
-  )
+    (setf (gui:w items-group) (gui:w root-element))
+
+    (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:x code-field) (+ (floor (gui:w root-element) 2) *score-padding*))
+    (setf (gui:x code-prompt) (- (floor (gui:w root-element) 2) *score-padding*))
+    (setf (gui:x join-button) (floor (gui:w root-element) 2))
+
+    (setf (gui:x popup) (floor (gui:w (gui:parent popup)) 2))
+    (setf (gui:y popup) (floor (gui:h (gui:parent popup)) 2))
+    (setf (gui:w popup) (+ (gui:w popup-text) (* *score-padding* 2)))
+    (setf (gui:h popup) (+ (gui:h popup-text) (* *score-padding* 2)))))

client/src/main-menu.lisp

@@ -23,58 +23,58 @@
 
 (defun open-main-menu ()
   (let* ((title (gui:make-text          :text "Pariatech's Pong Game"
-			                :font +menu-font+
+			                :font *menu-font*
-			                :font-size +menu-title-font-size+
+			                :font-size *menu-title-font-size*
-			                :color +menu-text-color+
+			                :color *menu-text-color*
-					:y +title-top-padding+
+					:y *title-top-padding*
 			                :h-align :center))
 	 (local-title (gui:make-text    :text "Local"
-				        :font +menu-font+
+				        :font *menu-font*
-				        :font-size +menu-group-title-font-size+
+				        :font-size *menu-group-title-font-size*
-				        :color +menu-text-color+
+				        :color *menu-text-color*
 				        :h-align :center))
 	 (1-player (make-menu-item      (:y (+ (gui:y local-title)
 					       (gui:h local-title)
-					       +menu-group-padding+)
+					       *menu-group-padding*)
-					 :text +menu-local-1-player+
+					 :text *menu-local-1-player*
-				         :font +menu-font+
+				         :font *menu-font*
-				         :font-size +menu-font-size+
+				         :font-size *menu-font-size*
-				         :color +menu-text-color+
+				         :color *menu-text-color*
 				         :h-align :center)
 					:action #'start-1-player-game))
 	 (2-players (make-menu-item     (:y (+ (gui:y (menu-item-text 1-player))
 					       (gui:h (menu-item-text 1-player))
-					       +menu-padding+)
+					       *menu-padding*)
-					 :text +menu-local-2-players+
+					 :text *menu-local-2-players*
-					 :font +menu-font+
+					 :font *menu-font*
-					 :font-size +menu-font-size+
+					 :font-size *menu-font-size*
-					 :color +menu-text-color+
+					 :color *menu-text-color*
 					 :h-align :center)
 					:action #'start-2-players-game))
 	 (online-title (gui:make-text   :y (+ (gui:y (menu-item-text 2-players))
 					      (gui:h (menu-item-text 2-players))
-					      +menu-group-padding+)
+					      *menu-group-padding*)
 					:text "Online"
-				        :font +menu-font+
+				        :font *menu-font*
-				        :font-size +menu-group-title-font-size+
+				        :font-size *menu-group-title-font-size*
-				        :color +menu-text-color+
+				        :color *menu-text-color*
 				        :h-align :center))
 	 (online-create (make-menu-item (:y (+ (gui:y online-title)
 					       (gui:h online-title)
-					       +menu-group-padding+)
+					       *menu-group-padding*)
-					 :text +menu-online-create+
+					 :text *menu-online-create*
-					 :font +menu-font+
+					 :font *menu-font*
-					 :font-size +menu-font-size+
+					 :font-size *menu-font-size*
-					 :color +menu-text-color+
+					 :color *menu-text-color*
 					 :h-align :center)
 					:action #'open-create-online-game-scene))
 	 (online-join (make-menu-item   (:y (+ (gui:y (menu-item-text online-create))
 					       (gui:h (menu-item-text online-create))
-					       +menu-padding+)
+					       *menu-padding*)
-					 :text +menu-online-join+
+					 :text *menu-online-join*
-				         :font +menu-font+
+				         :font *menu-font*
-				         :font-size +menu-font-size+
+				         :font-size *menu-font-size*
-				         :color +menu-text-color+
+				         :color *menu-text-color*
 				         :h-align :center)
 					:action #'open-join-online-game-scene))
 	 (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join))
@@ -147,10 +147,10 @@
 
 (defmethod on-update ((scene main-menu) timelapse)
   (with-slots (local-1-player local-2-players online-create online-join) scene
-    (update-text-if-hovered (menu-item-text local-1-player) +menu-local-1-player+)
+    (update-text-if-hovered (menu-item-text local-1-player) *menu-local-1-player*)
-    (update-text-if-hovered (menu-item-text local-2-players) +menu-local-2-players+)
+    (update-text-if-hovered (menu-item-text local-2-players) *menu-local-2-players*)
-    (update-text-if-hovered (menu-item-text online-create) +menu-online-create+)
+    (update-text-if-hovered (menu-item-text online-create) *menu-online-create*)
-    (update-text-if-hovered (menu-item-text online-join) +menu-online-join+)
+    (update-text-if-hovered (menu-item-text online-join) *menu-online-join*)
     (act-on-click local-1-player)
     (act-on-click local-2-players)
     (act-on-click online-create)

client/src/main.lisp

@@ -1,23 +0,0 @@
-(in-package :pong.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/online-game.lisp

@@ -9,9 +9,6 @@
   ((keyboard :initform (make-hash-table) :reader online-game-keyboard)
    (paddle :initarg :paddle :initform :left :reader online-game-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))
@@ -20,18 +17,29 @@
 	    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)))
+    (let ((current-time (g: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)))
 
+(defmethod apply-message ((msg g:state-updated-message))
+  (setf (g:game-state *game*) (g:game-state msg))
+  (apply-actions *game*))
+
+(defmethod apply-message ((msg g:game-joined-message))
+  (setf (gui:visible (game-scene-popup *scene*)) nil))
+
+(defmethod apply-message ((msg g:player-left-message))
+  (setf (gui:visible (game-scene-popup *scene*)) t)
+  (setf (gui:text (game-scene-popup-text *scene*))
+	(format nil "Player ~a left the game.~%Waiting for player..." (g:player-name msg))))
+
 (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-message msg)))))
-	  (apply-actions *game*)))))
   (when *game*
     (game-thread)))
 
@@ -51,9 +59,30 @@
   (cpk:encode data :stream *stream*)
   (force-output *stream*))
 
-(defun join-online-game ()
+(defmethod handle-join-online-game-response ((response g:game-joined-message) code)
+  (let ((player-paddle (g:player-paddle response))
+	(game-state (g:game-state response)))
+    (start-online-game :code code
+		       :paddle player-paddle
+		       :state game-state)
+    :success))
+
+(defmethod handle-join-online-game-response ((response g:game-full) code)
+  (declare (ignore code))
+  :game-full)
+
+(defmethod handle-join-online-game-response ((response g:game-does-not-exist) code)
+  (declare (ignore code))
+  :game-does-not-exist)
+
+(defun join-online-game (name code)
   (open-socket)
-  (start-online-game))
+  (write-to-server (make-instance 'g:join-game-message
+				  :player-name name
+				  :game-code code))
+  (usocket:wait-for-input *socket*) ;; wait for response
+  (let ((response (cpk:decode-stream *stream*)))
+    (handle-join-online-game-response response code)))
 
 (defun create-online-game (name)
   (open-socket)
@@ -67,12 +96,11 @@
 	 (game-state (g:game-state response)))
     (start-online-game :code game-code
 		       :paddle player-paddle
-		       :state game-state)))
+		       :state game-state))
+
+  (setf (gui:visible (game-scene-popup *scene*)) t))
 
-(defmethod g:on-init ((game online-game))
+(defmethod g:on-init ((game online-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))))

game/src/action.lisp

@@ -2,7 +2,7 @@
 
 (defclass action ()
   ((timestamp :initarg :timestamp
-	      :initform (/ (get-internal-real-time) internal-time-units-per-second)
+	      :initform (get-time)
 	      :reader action-timestamp)
    (paddle :initarg :paddle :initform nil :reader paddle)))
 

game/src/game.lisp

@@ -7,6 +7,10 @@
 (defconstant +max-launch-angle+ (/ pi 4)) ; 45°
 (defconstant +ball-speed+ 0.5)
 
+(defun get-time ()
+  (multiple-value-bind (sec nsec) (sb-ext:get-time-of-day)
+    (+ sec (/ nsec 1000000))))
+
 (defstruct paddle
   (y  0.0 :type float)
   (vy 0.0 :type float))
@@ -19,7 +23,7 @@
 
 (defclass state ()
   ((timestamp    :initarg :timestamp
-	         :initform (/ (get-internal-real-time) internal-time-units-per-second)
+	         :initform (get-time)
 	         :accessor state-timestamp)
    (left-paddle  :initarg :left-paddle
 		 :initform (make-paddle :y 0.5)
@@ -76,6 +80,7 @@
 (defgeneric on-quit (game))
 
 (defun update-paddle (paddle timelapse)
+  ;; (format t "timelapse: ~a~%" (float timelapse))
  (setf (paddle-y paddle)
        (min (max (+ (paddle-y paddle) (* (paddle-vy paddle) timelapse))
 		 (/ +paddle-height+ 2))
@@ -174,9 +179,11 @@
   (let* ((state (game-state game))
 	 (left-paddle (state-left-paddle state))
 	 (right-paddle (state-right-paddle state))
+	 (left-player (state-left-player state))
+	 (right-player (state-right-player state))
 	 (ball (state-ball state))
 	 (paused (state-paused state)))
-    (unless paused
+    (unless (or paused (not (and left-player right-player)))
       (update-paddle left-paddle timelapse)
       (update-paddle right-paddle timelapse)
       (update-ball state ball left-paddle right-paddle timelapse))))

game/src/messages.lisp

@@ -23,9 +23,19 @@
   ((player-paddle :initarg :player-paddle :initform nil :reader player-paddle)
    (game-state :initarg :game-state :initform nil :reader game-state)))
 
+(defclass player-left-message ()
+  ((player-name :initarg :player-name :initform nil :reader player-name)
+   (game-state :initarg :game-state :initform nil :reader game-state)))
+
+(defclass game-does-not-exist () ())
+(defclass game-full () ())
+
 (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)
+(cpk:defencoding player-left-message player-name game-state)
+(cpk:defencoding game-does-not-exist)
+(cpk:defencoding game-full)

game/src/package.lisp

@@ -52,7 +52,12 @@
 	   #:join-game-message
 	   #:game-created-message
 	   #:game-joined-message
+	   #:player-left-message
+	   #:game-does-not-exist
+	   #:game-full
 	   #:game-code
 	   #:game-action
 	   #:player-name
-	   #:player-paddle))
+	   #:player-paddle
+	   #:get-time
+	   ))

init.lisp

@@ -8,3 +8,6 @@
 (ql:register-local-projects)
 
 (pushnew #P"/usr/local/lib/" cffi:*foreign-library-directories*)
+
+(ql:quickload "client")
+(in-package :pong.client)

server/src/server.lisp

@@ -2,6 +2,12 @@
 
 (defclass online-game (g:online-game)
   ((lock :initarg :lock :initform (bt:make-lock) :reader online-game-lock)
+   (left-player-connection :initarg :left-player-connection
+			   :initform nil
+			   :accessor online-game-left-player-connection)
+   (right-player-connection :initarg :right-player-connection
+			    :initform nil
+			    :accessor online-game-right-player-connection)
    (connections :initarg :connections :initform nil :accessor online-game-connections)))
 
 (defparameter *server* nil)
@@ -16,9 +22,6 @@
 (defmacro loop-while-server-running (&body 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)))
     (when stream
@@ -35,18 +38,22 @@
 	   (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))
+	    do (g:on-update game (print (float (- (g:action-timestamp action) last-time))))
 	       (setf last-time (g:action-timestamp action))
 	       (g:apply-action action game))
 
-      (let ((current-time (get-time)))
+      (let ((current-time (g: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)))))
+	    do (handler-case (send-message-to-client con g:state-updated-message :game-state state)
+		 (t ()
+		   (format t "Socket closed???~%")
+		   (close-connection con)))
+	       ))))
 
 (defun update-games ()
   (loop-while-server-running
@@ -67,8 +74,31 @@
 
 (defun close-connection (connection)
   (usocket:socket-close connection) 
-  (let ((game (gethash connection *connections*)))
+  (let* ((game (gethash connection *connections*))
-    (when game (remhash (g:game-code game) *games*)))
+	 (state (and game (g:game-state game))))
+    (when game
+      (setf (online-game-connections game) (remove connection (online-game-connections game)))
+      (cond ((eq (online-game-left-player-connection game) connection)
+	     (setf (online-game-left-player-connection game) nil)
+	     (let ((player (g:state-left-player state)))
+	       (setf (g:state-left-player state) nil)
+	       (when (online-game-right-player-connection game)
+		 (send-message-to-client (online-game-right-player-connection game)
+					 g:player-left-message
+					 :player-name player
+					 :game-state state))))
+	    ((eq (online-game-right-player-connection game) connection)
+	     (setf (online-game-right-player-connection game) nil)
+	     (let ((player (g:state-right-player state)))
+	       (setf (g:state-right-player state) nil)
+	       (when (online-game-left-player-connection game)
+		 (send-message-to-client (online-game-left-player-connection game)
+					 g:player-left-message
+					 :player-name player
+					 :game-state state)))))
+      
+      (unless (online-game-connections game)
+	(remhash (g:game-code game) *games*))))
   (remhash connection *connections*))
 
 (defun start-server (port)
@@ -106,9 +136,10 @@
 (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)))))
+						   :left-player (g:player-name msg))
+			     :connections (list connection)
+			     :left-player-connection connection)))
     (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)
@@ -118,24 +149,37 @@
     (force-output stream)))
 
 (defmethod handle-message ((msg g:join-game-message) stream connection)
-  (let* ((game (gethash (g:game-code msg) *games*))
+  (let ((game (gethash (g:game-code msg) *games*)))
-	 (state (g:game-state game))
+    (if game
-	 (left-player (g:state-left-player state))
+	(let ((left-player (g:state-left-player (g:game-state game)))
-	 (right-player (g:state-right-player state))
+	      (right-player (g:state-right-player (g:game-state game))))
-	 (paddle (cond (left-player :right) (right-player :left)))
+	  (if (or (not left-player) (not right-player))
+	      (let ((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))
+		(setf (gethash connection *connections*) game)
 
 		(case paddle
-	(:left (setf (g:state-left-player state) player))
+		  (:left
-	(:right (setf (g:state-right-player state) player)))
+		   (setf (g:state-left-player (g:game-state game)) player)
+		   (setf (online-game-left-player-connection game) connection))
+		  (:right
+		   (setf (g:state-right-player (g:game-state game)) player)
+		   (setf (online-game-right-player-connection game) connection)))
+
+		(setf (g:game-state game)
+		      (make-instance 'g:state
+				     :left-player (g:state-left-player (g:game-state game))
+				     :right-player (g:state-right-player (g:game-state game))))
+		(g:random-launch-ball (g:game-state game))
 
 		(let ((response (make-instance 'g:game-joined-message
 					       :player-paddle paddle
-				     :game-state state)))
+					       :game-state (g:game-state game))))
 		  (loop for con in (online-game-connections game)
-	      do (send-data-to-client response con))))))
+			do (send-data-to-client response con))))
+	      (send-message-to-client connection g:game-full)))
+	(send-message-to-client connection g:game-does-not-exist))))
 
 ;; (start-server 54321)
 ;; (stop-server)