diff --git a/client/client.asd b/client/client.asd index 469b48a..846a23f 100644 --- a/client/client.asd +++ b/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"))) diff --git a/client/src/client.lisp b/client/src/client.lisp index 6d56b15..e8c9868 100644 --- a/client/src/client.lisp +++ b/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)) diff --git a/client/src/constants.lisp b/client/src/constants.lisp index 5c30f07..981119a 100644 --- a/client/src/constants.lisp +++ b/client/src/constants.lisp @@ -1,17 +1,17 @@ (in-package :pong.client) -(defconstant +title-top-padding+ 30) -(defconstant +menu-padding+ 10) -(defconstant +menu-group-padding+ 20) -(defconstant +menu-font+ "assets/ComicMono.ttf") -(defconstant +menu-font-size+ 32) -(defconstant +menu-title-font-size+ 52) -(defconstant +menu-group-title-font-size+ 42) -(defconstant +menu-text-color+ r:+white+) -(defconstant +menu-local-1-player+ "1 Player") -(defconstant +menu-local-2-players+ "2 Players") -(defconstant +menu-online-create+ "Create Game") -(defconstant +menu-online-join+ "Join Game") -(defconstant +score-txt-size+ 32) -(defconstant +score-padding+ 20) -(defconstant +score-font+ "assets/ComicMono.ttf") +(defparameter *title-top-padding* 30) +(defparameter *menu-padding* 10) +(defparameter *menu-group-padding* 20) +(defparameter *menu-font* "client/assets/ComicMono.ttf") +(defparameter *menu-font-size* 32) +(defparameter *menu-title-font-size* 52) +(defparameter *menu-group-title-font-size* 42) +(defparameter *menu-text-color* r:+white+) +(defparameter *menu-local-1-player* "1 Player") +(defparameter *menu-local-2-players* "2 Players") +(defparameter *menu-online-create* "Create Game") +(defparameter *menu-online-join* "Join Game") +(defparameter *score-txt-size* 32) +(defparameter *score-padding* 20) +(defparameter *score-font* "client/assets/ComicMono.ttf") diff --git a/client/src/create-online-game-scene.lisp b/client/src/create-online-game-scene.lisp index 3c2b3c5..e4fcf5b 100644 --- a/client/src/create-online-game-scene.lisp +++ b/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-size +menu-title-font-size+ - :y +title-top-padding+ + :font *menu-font* + :font-size *menu-title-font-size* + :y *title-top-padding* :h-align :center :text "Create online game")) (name-field (gui:make-text :color r:+white+ - :font +menu-font+ - :font-size +menu-font-size+ + :font *menu-font* + :font-size *menu-font-size* :v-align :middle)) (prompt (gui:make-text :color r:+white+ - :font +menu-font+ - :font-size +menu-font-size+ + :font *menu-font* + :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 prompt) (- (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:y name-field) (floor (gui:h root-element) 2)) (setf (gui:y prompt) (floor (gui:h root-element) 2)))) diff --git a/client/src/game-scene.lisp b/client/src/game-scene.lisp index 57967a0..8cefab1 100644 --- a/client/src/game-scene.lisp +++ b/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-size +score-txt-size+ + :font *score-font* + :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-size +score-txt-size+ - :y +score-padding+)) + :font *score-font* + :font-size *score-txt-size* + :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-size +score-txt-size+ - :x +score-padding+ - :y +score-padding+)) + :font *score-font* + :font-size *score-txt-size* + :x *score-padding* + :y *score-padding*)) (right-player (gui:make-text :color r:+white+ - :font +score-font+ - :font-size +score-txt-size+ + :font *score-font* + :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-size +score-txt-size+ - :y +score-padding+ + :font *score-font* + :font-size *score-txt-size* + :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-size +score-txt-size+ + :font *score-font* + :font-size *score-txt-size* :h-align :center :text "Yes")) (quit-menu-no (gui:make-text :color r:+white+ - :font +score-font+ - :font-size +score-txt-size+ + :font *score-font* + :font-size *score-txt-size* :h-align :center :text "No")) (code (gui:make-text :color r:+white+ - :font +score-font+ - :font-size +score-txt-size+ - :x +score-padding+ - :v-align :bottom))) + :font *score-font* + :font-size *score-txt-size* + :x *score-padding* + :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 no) (+ (gui:y text) (gui:h text) +score-padding+)) - (setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +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: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)))) diff --git a/client/src/gui/package.lisp b/client/src/gui/package.lisp index bf9528e..a7f1c39 100644 --- a/client/src/gui/package.lisp +++ b/client/src/gui/package.lisp @@ -44,4 +44,5 @@ #:border-thickness #:cursor #:padding - #:make-text-field)) + #:make-text-field + )) diff --git a/client/src/gui/text-field.lisp b/client/src/gui/text-field.lisp index 7310e57..1aa39d8 100644 --- a/client/src/gui/text-field.lisp +++ b/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 - (when (and font text) + (with-slots (w h font font-size text spacing padding min-width) txt + (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 h (+ (v:vy size) (* padding 2))) + (setf w (max min-width (+ (v:vx 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) - (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)) + (let ((size (r:measure-text-ex (load-font font font-size) + (str:substring 0 cursor text) + (float font-size) + spacing))) + (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))) diff --git a/client/src/join-online-game-scene.lisp b/client/src/join-online-game-scene.lisp index 6a0f13a..b501f52 100644 --- a/client/src/join-online-game-scene.lisp +++ b/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-size *menu-title-font-size* + :y *title-top-padding* + :h-align :center + :text "Join online game")) + (name-field (gui:make-text-field :y 0 + :color r:+white+ + :font *menu-font* + :font-size *menu-font-size* + :focusp t + :border :solid + :border-color r:+white+ + :border-thickness 1 + :cursor 0 + :v-align :middle + :padding 10 + :min-width 150)) + (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 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)) - (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) + :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 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)) - ;; when (= key r:+key-enter+) - ;; do (create-online-game name) + do (cond ((gui:focusp name-field) + (setf (gui:cursor name-field) + (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: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))) - ) + (setf (gui:text code-field) code) + + (setf (gui:x items-group) (floor (gui:w 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))))) diff --git a/client/src/main-menu.lisp b/client/src/main-menu.lisp index 6e3e212..2ab3fd9 100644 --- a/client/src/main-menu.lisp +++ b/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-size +menu-title-font-size+ - :color +menu-text-color+ - :y +title-top-padding+ + :font *menu-font* + :font-size *menu-title-font-size* + :color *menu-text-color* + :y *title-top-padding* :h-align :center)) (local-title (gui:make-text :text "Local" - :font +menu-font+ - :font-size +menu-group-title-font-size+ - :color +menu-text-color+ + :font *menu-font* + :font-size *menu-group-title-font-size* + :color *menu-text-color* :h-align :center)) (1-player (make-menu-item (:y (+ (gui:y local-title) (gui:h local-title) - +menu-group-padding+) - :text +menu-local-1-player+ - :font +menu-font+ - :font-size +menu-font-size+ - :color +menu-text-color+ + *menu-group-padding*) + :text *menu-local-1-player* + :font *menu-font* + :font-size *menu-font-size* + :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+) - :text +menu-local-2-players+ - :font +menu-font+ - :font-size +menu-font-size+ - :color +menu-text-color+ + *menu-padding*) + :text *menu-local-2-players* + :font *menu-font* + :font-size *menu-font-size* + :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-size +menu-group-title-font-size+ - :color +menu-text-color+ + :font *menu-font* + :font-size *menu-group-title-font-size* + :color *menu-text-color* :h-align :center)) (online-create (make-menu-item (:y (+ (gui:y online-title) (gui:h online-title) - +menu-group-padding+) - :text +menu-online-create+ - :font +menu-font+ - :font-size +menu-font-size+ - :color +menu-text-color+ + *menu-group-padding*) + :text *menu-online-create* + :font *menu-font* + :font-size *menu-font-size* + :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+) - :text +menu-online-join+ - :font +menu-font+ - :font-size +menu-font-size+ - :color +menu-text-color+ + *menu-padding*) + :text *menu-online-join* + :font *menu-font* + :font-size *menu-font-size* + :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-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-join) +menu-online-join+) + (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 online-create) *menu-online-create*) + (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) diff --git a/client/src/main.lisp b/client/src/main.lisp deleted file mode 100644 index e7f6321..0000000 --- a/client/src/main.lisp +++ /dev/null @@ -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))))))) diff --git a/client/src/online-game.lisp b/client/src/online-game.lisp index 6a6db5f..2da170e 100644 --- a/client/src/online-game.lisp +++ b/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-actions *game*))))) + (apply-message msg))))) (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)) - (format t "~a~%" game) - ;; (g:random-launch-ball (g:game-state game)) - ) +(defmethod g:on-init ((game online-game))) (defun is-first-key-down-p (key keyboard) (and (r:is-key-down key) (not (gethash key keyboard)))) diff --git a/game/src/action.lisp b/game/src/action.lisp index f0794fc..7a8717b 100644 --- a/game/src/action.lisp +++ b/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))) diff --git a/game/src/game.lisp b/game/src/game.lisp index 6058e2c..5f10df7 100644 --- a/game/src/game.lisp +++ b/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)))) diff --git a/game/src/messages.lisp b/game/src/messages.lisp index a91d278..e9a2dc3 100644 --- a/game/src/messages.lisp +++ b/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) diff --git a/game/src/package.lisp b/game/src/package.lisp index 51b01e2..fa461a3 100644 --- a/game/src/package.lisp +++ b/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 + )) diff --git a/init.lisp b/init.lisp index d3a0045..a02e75e 100644 --- a/init.lisp +++ b/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) diff --git a/server/src/server.lisp b/server/src/server.lisp index 9ca7844..316ecd6 100644 --- a/server/src/server.lisp +++ b/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*))) - (when game (remhash (g:game-code game) *games*))) + (let* ((game (gethash connection *connections*)) + (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*)) - (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)))))) + (let ((game (gethash (g:game-code msg) *games*))) + (if game + (let ((left-player (g:state-left-player (g:game-state game))) + (right-player (g:state-right-player (g:game-state game)))) + (if (or (not left-player) (not right-player)) + (let ((paddle (cond (left-player :right) (right-player :left))) + (player (g:player-name msg))) + (pushnew connection (online-game-connections game)) + (setf (gethash connection *connections*) game) + + (case paddle + (:left + (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 (g:game-state game)))) + (loop for con in (online-game-connections game) + 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)