Browse Source

online finished

master
Gabriel Pariat 2 years ago
parent
commit
38db4abbe0
  1. 6
      client/client.asd
  2. 4
      client/src/client.lisp
  3. 30
      client/src/constants.lisp
  4. 19
      client/src/create-online-game-scene.lisp
  5. 94
      client/src/game-scene.lisp
  6. 3
      client/src/gui/package.lisp
  7. 39
      client/src/gui/text-field.lisp
  8. 181
      client/src/join-online-game-scene.lisp
  9. 70
      client/src/main-menu.lisp
  10. 23
      client/src/main.lisp
  11. 54
      client/src/online-game.lisp
  12. 2
      game/src/action.lisp
  13. 11
      game/src/game.lisp
  14. 10
      game/src/messages.lisp
  15. 7
      game/src/package.lisp
  16. 3
      init.lisp
  17. 100
      server/src/server.lisp

6
client/client.asd

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

4
client/src/client.lisp

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

30
client/src/constants.lisp

@ -1,17 +1,17 @@
(in-package :pong.client) (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")

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

@ -11,18 +11,18 @@
:h-align :center :h-align :center
:v-align :middle)) :v-align :middle))
(title (gui:make-text :color r:+white+ (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 :h-align :center
:text "Create online game")) :text "Create online game"))
(name-field (gui:make-text :color r:+white+ (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)) :v-align :middle))
(prompt (gui:make-text :color r:+white+ (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 :h-align :right
:v-align :middle :v-align :middle
:text "What is your name?:"))) :text "What is your name?:")))
@ -38,7 +38,6 @@
;; Might be interesting to add repeating keys, but I don't care. ;; Might be interesting to add repeating keys, but I don't care.
(loop for key = (r:get-key-pressed) (loop for key = (r:get-key-pressed)
while (plusp key) while (plusp key)
do (format t "~a~%" key)
when (= key r:+key-escape+) when (= key r:+key-escape+)
do (open-main-menu) do (open-main-menu)
when (= key r:+key-backspace+) when (= key r:+key-backspace+)
@ -53,7 +52,7 @@
(position-root root-element) (position-root root-element)
(setf (gui:x title) (floor (gui:w root-element) 2)) (setf (gui:x title) (floor (gui:w root-element) 2))
(setf (gui:text name-field) name) (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 name-field) (floor (gui:h root-element) 2))
(setf (gui:y prompt) (floor (gui:h root-element) 2)))) (setf (gui:y prompt) (floor (gui:h root-element) 2))))

94
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-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text)
(quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes) (quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes)
(quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no) (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no)
(code :initarg :code :initform nil :reader game-scene-code))) (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) (defun open-game (game)
(let ((root-element (gui:make-rectangle :color r:+darkgray+ (let ((root-element (gui:make-rectangle :color r:+darkgray+
:h-align :center :h-align :center
:v-align :middle)) :v-align :middle))
(left-score (gui:make-text :color r:+white+ (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 :h-align :right
:y +score-padding+)) :y *score-padding*))
(right-score (gui:make-text :color r:+white+ (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+ (left-paddle (gui:make-rectangle :color r:+white+
:v-align :middle)) :v-align :middle))
(right-paddle (gui:make-rectangle :color r:+white+ (right-paddle (gui:make-rectangle :color r:+white+
:h-align :right :h-align :right
:v-align :middle)) :v-align :middle))
(left-player (gui:make-text :color r:+white+ (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+ (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 :h-align :right
:y +score-padding+)) :y *score-padding*))
(ball (gui:make-rectangle :color r:+white+ (ball (gui:make-rectangle :color r:+white+
:h-align :center :h-align :center
:v-align :middle)) :v-align :middle))
@ -54,34 +56,47 @@
:v-align :middle :v-align :middle
:visible nil)) :visible nil))
(quit-menu-text (gui:make-text :color r:+white+ (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 :h-align :center
:text "Do you really want to quit the game?")) :text "Do you really want to quit the game?"))
(quit-menu-yes (gui:make-text :color r:+white+ (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 :h-align :center
:text "Yes")) :text "Yes"))
(quit-menu-no (gui:make-text :color r:+white+ (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 :h-align :center
:text "No")) :text "No"))
(code (gui:make-text :color r:+white+ (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 (gui:add-children quit-menu
quit-menu-text quit-menu-text
quit-menu-yes quit-menu-yes
quit-menu-no) quit-menu-no)
(gui:add-children popup popup-text)
(gui:add-children root-element (gui:add-children root-element
quit-menu quit-menu
popup
left-score left-score
right-score right-score
left-paddle left-paddle
@ -108,10 +123,12 @@
:quit-menu-text quit-menu-text :quit-menu-text quit-menu-text
:quit-menu-yes quit-menu-yes :quit-menu-yes quit-menu-yes
:quit-menu-no quit-menu-no :quit-menu-no quit-menu-no
:code code))) :code code
:popup popup
:popup-text popup-text)))
(defun position-score (el direction) (defun position-score (el direction)
(setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) +score-padding+))) (setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) *score-padding*)))
(defun position-paddle (paddle el) (defun position-paddle (paddle el)
(let ((paddle-y (g:paddle-y paddle)) (let ((paddle-y (g:paddle-y paddle))
@ -139,21 +156,27 @@
(setf (gui:end-y el) (gui:h (gui:parent el)))) (setf (gui:end-y el) (gui:h (gui:parent el))))
(defun position-right-player (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) (defun position-quit-menu (menu text yes no)
(setf (gui:x menu) (floor (gui:w (gui:parent menu)) 2)) (setf (gui:x menu) (floor (gui:w (gui:parent menu)) 2))
(setf (gui:y menu) (floor (gui:h (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 text) (floor (gui:w menu) 2))
(setf (gui:x yes) (floor (gui:w menu) 3)) (setf (gui:x yes) (floor (gui:w menu) 3))
(setf (gui:x no) (floor (gui:w menu) 3/2)) (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) (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) (defmethod on-update ((scene game-scene) timelapse)
(g:on-update (game-scene-game scene) timelapse) (g:on-update (game-scene-game scene) timelapse)
@ -171,7 +194,7 @@
(open-main-menu))) (open-main-menu)))
(defmethod on-draw ((scene game-scene)) (defmethod on-draw ((scene game-scene))
(with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no 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 scene
(let ((game-state (g:game-state game))) (let ((game-state (g:game-state game)))
(position-root root-element) (position-root root-element)
@ -189,4 +212,5 @@
(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) (setf (gui:text code) (when (eq (type-of game) 'online-game)
(format nil "Code: ~a" (g:game-code game)))) (format nil "Code: ~a" (g:game-code game))))
(position-code code)))) (position-code code)
(position-popup popup popup-text))))

3
client/src/gui/package.lisp

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

39
client/src/gui/text-field.lisp

@ -6,17 +6,23 @@
(border-color :initarg :border-color :initform r:+black+ :accessor border-color) (border-color :initarg :border-color :initform r:+black+ :accessor border-color)
(border-thickness :initarg :border-thickness :initform 1 :accessor border-thickness) (border-thickness :initarg :border-thickness :initform 1 :accessor border-thickness)
(cursor :initarg :cursor :initform nil :accessor cursor) (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)) (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) (let ((size (r:measure-text-ex (load-font font font-size)
text (or text "")
(float font-size) (float font-size)
spacing))) 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-x txt)
(update-y txt))))) (update-y txt)))))
@ -31,15 +37,16 @@
(float border-thickness) (float border-thickness)
border-color)) border-color))
(when focusp (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 (float font-size)
(str:repeat cursor " ") spacing)))
(string #\left_one_eighth_block)) (r:draw-line-ex (v:vec2 (+ screen-x padding (v:vx size))
(v:vec (float (+ screen-x padding)) (float (+ screen-y padding))) (+ screen-y padding))
(float font-size) (v:vec2 (+ screen-x padding (v:vx size))
spacing (+ screen-y padding (v:vy size)))
color)) 1.0
color)))
(when text (when text
(r:draw-text-ex (load-font font font-size) (r:draw-text-ex (load-font font font-size)
text text
@ -49,5 +56,5 @@
color))))) color)))))
(defmacro make-text-field (&rest args) (defmacro make-text-field (&rest args)
`(make-instance 'text-field ,@args)) `(update (make-instance 'text-field ,@args)))

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

@ -18,64 +18,165 @@
:reader join-online-game-scene-code-prompt) :reader join-online-game-scene-code-prompt)
(join-button :initarg :join-button (join-button :initarg :join-button
:initform nil :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 () (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 :h-align :center
:v-align :middle)) :v-align :middle
(title (gui:make-text :color r:+white+ :visible nil))
:font +menu-font+ (popup-text (gui:make-text :color r:+white+
:font-size +menu-title-font-size+ :font *score-font*
:y +title-top-padding+ :font-size *score-txt-size*
:h-align :center :y *score-padding*
:text "Join online game")) :x *score-padding*)))
(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)
(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 (set-scene (make-instance 'join-online-game-scene :root-element root-element
:title title :title title
:name-field name-field :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) (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. ;; 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) (loop for key = (r:get-key-pressed)
while (plusp key) while (plusp key)
do (format t "~a~%" key)
when (= key r:+key-escape+) when (= key r:+key-escape+)
do (open-main-menu) do (open-main-menu)
when (= key r:+key-backspace+) 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)) 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)) (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) (position-root root-element)
(setf (gui:x title) (floor (gui:w root-element) 2)) (setf (gui:x title) (floor (gui:w root-element) 2))
(setf (gui:text name-field) name) (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)))))

70
client/src/main-menu.lisp

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

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

54
client/src/online-game.lisp

@ -9,9 +9,6 @@
((keyboard :initform (make-hash-table) :reader online-game-keyboard) ((keyboard :initform (make-hash-table) :reader online-game-keyboard)
(paddle :initarg :paddle :initform :left :reader online-game-paddle))) (paddle :initarg :paddle :initform :left :reader online-game-paddle)))
(defun get-time ()
(/ (get-internal-real-time) internal-time-units-per-second))
(defun apply-actions (game) (defun apply-actions (game)
(let* ((state-timestamp (g:state-timestamp (g:game-state game))) (let* ((state-timestamp (g:state-timestamp (g:game-state game)))
(last-time state-timestamp)) (last-time state-timestamp))
@ -20,18 +17,29 @@
do (g:on-update game (- (g:action-timestamp action) last-time)) do (g:on-update game (- (g:action-timestamp action) last-time))
(setf last-time (g:action-timestamp action)) (setf last-time (g:action-timestamp action))
(g:apply-action action game)) (g:apply-action action game))
(let ((current-time (get-time))) (let ((current-time (g:get-time)))
(g:on-update game (- current-time last-time)) (g:on-update game (- current-time last-time))
(setf (g:state-timestamp (g:game-state game)) current-time)) (setf (g:state-timestamp (g:game-state game)) current-time))
(setf (g:actions game) nil))) (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 () (defun game-thread ()
(when (usocket:wait-for-input *socket* :ready-only t :timeout 5) (when (usocket:wait-for-input *socket* :ready-only t :timeout 5)
(bt:with-lock-held (*lock*) (bt:with-lock-held (*lock*)
(when *game* (when *game*
(let ((msg (cpk:decode-stream *stream*))) (let ((msg (cpk:decode-stream *stream*)))
(setf (g:game-state *game*) (g:game-state msg)) (apply-message msg)))))
(apply-actions *game*)))))
(when *game* (when *game*
(game-thread))) (game-thread)))
@ -51,9 +59,30 @@
(cpk:encode data :stream *stream*) (cpk:encode data :stream *stream*)
(force-output *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) (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) (defun create-online-game (name)
(open-socket) (open-socket)
@ -67,12 +96,11 @@
(game-state (g:game-state response))) (game-state (g:game-state response)))
(start-online-game :code game-code (start-online-game :code game-code
:paddle player-paddle :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) (defun is-first-key-down-p (key keyboard)
(and (r:is-key-down key) (not (gethash key keyboard)))) (and (r:is-key-down key) (not (gethash key keyboard))))

2
game/src/action.lisp

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

11
game/src/game.lisp

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

10
game/src/messages.lisp

@ -23,9 +23,19 @@
((player-paddle :initarg :player-paddle :initform nil :reader player-paddle) ((player-paddle :initarg :player-paddle :initform nil :reader player-paddle)
(game-state :initarg :game-state :initform nil :reader game-state))) (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 game-action-message game-code game-action)
(cpk:defencoding state-updated-message game-state) (cpk:defencoding state-updated-message game-state)
(cpk:defencoding create-game-message player-name) (cpk:defencoding create-game-message player-name)
(cpk:defencoding join-game-message game-code 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-created-message game-code player-paddle game-state)
(cpk:defencoding game-joined-message 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)

7
game/src/package.lisp

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

3
init.lisp

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

100
server/src/server.lisp

@ -2,6 +2,12 @@
(defclass online-game (g:online-game) (defclass online-game (g:online-game)
((lock :initarg :lock :initform (bt:make-lock) :reader online-game-lock) ((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))) (connections :initarg :connections :initform nil :accessor online-game-connections)))
(defparameter *server* nil) (defparameter *server* nil)
@ -16,9 +22,6 @@
(defmacro loop-while-server-running (&body body) (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) (defun send-data-to-client (data client)
(let ((stream (usocket:socket-stream client))) (let ((stream (usocket:socket-stream client)))
(when stream (when stream
@ -35,18 +38,22 @@
(state (g:game-state game)) (state (g:game-state game))
(last-time (g:state-timestamp state))) (last-time (g:state-timestamp state)))
(loop for action in (sort actions '< :key #'g:action-timestamp) (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)) (setf last-time (g:action-timestamp action))
(g:apply-action action game)) (g:apply-action action game))
(let ((current-time (get-time))) (let ((current-time (g:get-time)))
(g:on-update game (- current-time last-time)) (g:on-update game (- current-time last-time))
(setf (g:state-timestamp state) current-time)) (setf (g:state-timestamp state) current-time))
(setf (g:actions game) nil) (setf (g:actions game) nil)
(loop for con in connections (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 () (defun update-games ()
(loop-while-server-running (loop-while-server-running
@ -67,8 +74,31 @@
(defun close-connection (connection) (defun close-connection (connection)
(usocket:socket-close 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*)) (remhash connection *connections*))
(defun start-server (port) (defun start-server (port)
@ -106,9 +136,10 @@
(defmethod handle-message ((msg g:create-game-message) stream connection) (defmethod handle-message ((msg g:create-game-message) stream connection)
(let ((game (make-instance 'online-game (let ((game (make-instance 'online-game
:state (make-instance 'g:state :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) (setf (gethash (g:game-code game) *games*) game)
(pushnew connection (online-game-connections game))
(setf (gethash connection *connections*) game) (setf (gethash connection *connections*) game)
(let ((response (make-instance 'g:game-created-message (let ((response (make-instance 'g:game-created-message
:game-code (g:game-code game) :game-code (g:game-code game)
@ -118,24 +149,37 @@
(force-output stream))) (force-output stream)))
(defmethod handle-message ((msg g:join-game-message) stream connection) (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))
(player (g:player-name msg))) (let ((paddle (cond (left-player :right) (right-player :left)))
(when (or (not left-player) (not right-player)) (player (g:player-name msg)))
(pushnew connection (online-game-connections game)) (pushnew connection (online-game-connections game))
(setf (gethash connection *connections*) game)
(case paddle
(:left (setf (g:state-left-player state) player)) (case paddle
(:right (setf (g:state-right-player state) player))) (:left
(setf (g:state-left-player (g:game-state game)) player)
(let ((response (make-instance 'g:game-joined-message (setf (online-game-left-player-connection game) connection))
:player-paddle paddle (:right
:game-state state))) (setf (g:state-right-player (g:game-state game)) player)
(loop for con in (online-game-connections game) (setf (online-game-right-player-connection game) connection)))
do (send-data-to-client response con))))))
(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) ;; (start-server 54321)
;; (stop-server) ;; (stop-server)

Loading…
Cancel
Save