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

move to actions system

master
Gabriel Pariat 2 years ago
parent
9aaf29fbbf
commit
dfe58d69b4
16 changed files with 675 additions and 251 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 10
      client/client.asd
  2. 105
      client/src/client.lisp
  3. 17
      client/src/constants.lisp
  4. 59
      client/src/create-online-game-scene.lisp
  5. 175
      client/src/game-scene.lisp
  6. 168
      client/src/local-game.lisp
  7. 27
      client/src/main-menu.lisp
  8. 30
      client/src/main.lisp
  9. 55
      client/src/online-game.lisp
  10. 5
      client/src/scene.lisp
  11. 5
      game/game.asd
  12. 55
      game/src/action.lisp
  13. 105
      game/src/game.lisp
  14. 15
      game/src/package.lisp
  15. 4
      server/server.asd
  16. 75
      server/src/server.lisp

10
client/client.asd
Unescape View File

@ -6,10 +6,11 @@
:license "AGPLv3" :license "AGPLv3"
:version "0.0.1" :version "0.0.1"
:serial t :serial t
:depends-on ("game" "cl-raylib" "3d-vectors") :depends-on ("game" "cl-raylib" "3d-vectors" "usocket" "bordeaux-threads" "str")
:pathname "src" :pathname "src"
:components :components
((:file "package") ((:file "package")
(:file "constants")
(:module "gui" (:module "gui"
:serial t :serial t
:components ((:file "package") :components ((:file "package")
@ -20,7 +21,10 @@
(:file "line"))) (:file "line")))
(:file "utils") (:file "utils")
(:file "scene") (:file "scene")
(:file "client")
(:file "game-scene")
(:file "local-game")
(:file "online-game")
(:file "main-menu") (:file "main-menu")
(:file "game") (:file "main")))
(:file "client")))

105
client/src/client.lisp
Unescape View File

@ -1,44 +1,65 @@
(in-package :pong.client) (in-package :pong.client)
(defparameter *scene* nil) (defparameter *client* nil)
(defun open-main-menu% () (defclass client ()
(setf *scene* (open-main-menu #'start-1-player-game ((ip :initarg :ip :initform nil :reader client-ip)
#'start-2-players-game (port :initarg :port :initform nil :reader client-port)
#'create-online-game (running-p :initform nil :accessor client-running-p)
#'join-online-game))) (socket :initform nil :accessor client-socket)))
(defun start-1-player-game () (defmethod listen-to ((self client))
(setf *scene* (open-game (make-instance 'local-game-1p) #'open-main-menu%))) (with-slots (running-p socket) self
(when (and running-p (usocket:wait-for-input socket :timeout 5) running-p)
(defun start-2-players-game () (let ((data (cpk:decode-stream (usocket:socket-stream socket))))
(setf *scene* (open-game (make-instance 'local-game-2p) #'open-main-menu%))) (format t "[CLIENT] Data received: ~a~%" data)))))
(defun create-online-game () (defmethod start ((self client))
(format t "~%Create online game.")) (with-slots (ip port running-p socket) self
(defun join-online-game () (format t "uh?~%")
(format t "~%Join online game.")) (unless running-p
(setf running-p t)
(defun main () (setf socket (usocket:socket-connect ip port :element-type 'unsigned-byte)))))
(let* ((last-time nil)
(current-time (get-internal-real-time))) (defmethod stop ((self client))
(r:with-window (800 600 "Pariatech's Pong") (with-slots (running-p socket) self
(gui:with-gui (setf running-p nil)
(open-main-menu%) (when socket
(usocket:socket-close socket))
(r:set-config-flags r:+flag-window-resizable+) (setf socket nil)))
(r:set-target-fps 60)
(r:set-exit-key 0) (defmethod write-to ((self client) data)
(loop (let ((stream (usocket:socket-stream (client-socket self))))
until (or (r:window-should-close) (scene-should-close *scene*)) (format t "[CLIENT] Data sent: ~a~%" data)
do (setf last-time current-time) (cpk:encode data :stream stream)
(setf current-time (/ (get-internal-real-time) internal-time-units-per-second)) (force-output stream)))
(let ((timelapse (- current-time last-time))) (defun handle-client ()
(on-update *scene* timelapse)) (loop while (and *client* (client-running-p *client*))
(r:with-drawing do (let ((data (listen-to *client*))))))
(r:clear-background r:+gray+)
(on-draw *scene*) (defun start-client (ip port)
(r:draw-fps 20 20))))))) (unless *client*
(setf *client* (make-instance 'client :ip ip :port port))
(main) (start *client*)
(bt:make-thread #'handle-client)))
(defun stop-client ()
(when *client*
(stop *client*))
(setf *client* nil))
(defun send-data-to-server (data)
(write-to *client* data))
(defun test-client ()
(start-client "127.0.0.1" 54321)
(write-to *client* "hello!")
(sleep 1.015)
(write-to *client* "bye!")
(stop-client))
;; (test-client)
;; (stop-client)

17
client/src/constants.lisp
Unescape View File

@ -0,0 +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")

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

@ -0,0 +1,59 @@
(in-package :pong.client)
(defclass create-online-game-scene (scene)
((name :initform "" :accessor create-online-game-scene-name)
(title :initarg :title :initform nil :reader create-online-game-scene-title)
(name-field :initarg :name-field :initform nil :reader create-online-game-scene-name-field)
(prompt :initarg :prompt :initform nil :reader create-online-game-scene-prompt)))
(defun open-create-online-game-scene ()
(let ((root-element (gui:make-rectangle :color r:+darkgray+
:h-align :center
:v-align :middle))
(title (gui:make-text :color r:+white+
:font +menu-font+
:font-size +menu-title-font-size+
:y +title-top-padding+
:h-align :center
:text "Create online game"))
(name-field (gui:make-text :color r:+white+
: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+
:h-align :right
:v-align :middle
:text "What is your name?:")))
(gui:add-children root-element title name-field prompt)
(set-scene (make-instance 'create-online-game-scene :root-element root-element
:name-field name-field
:title title
:prompt prompt))))
(defmethod on-update ((scene create-online-game-scene) timelapse)
(with-slots (name move-back) scene
;; Might be interesting to add repeating keys, but I don't care.
(loop for key = (r:get-key-pressed)
while (plusp key)
do (format t "~a~%" key)
when (= key r:+key-escape+)
do (open-main-menu)
when (= key r:+key-backspace+)
do (setf name (str:substring 0 -1 name))
when (= key r:+key-enter+)
do (start-online-game)
when (and (>= key 32) (<= key 96))
do (setf name (str:concat name (string (code-char key)))))))
(defmethod on-draw ((scene create-online-game-scene))
(with-slots (name root-element title name-field prompt) scene
(position-root root-element)
(setf (gui:x title) (floor (gui:w root-element) 2))
(setf (gui:text name-field) name)
(setf (gui:x name-field) (+ (floor (gui:w root-element) 2) +score-padding+))
(setf (gui:x 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))))

175
client/src/game.lisp → client/src/game-scene.lisp
Unescape View File

@ -1,16 +1,5 @@
(in-package :pong.client) (in-package :pong.client)
(defconstant +score-txt-size+ 32)
(defconstant +score-padding+ 20)
(defconstant +score-font+ "assets/ComicMono.ttf")
(defclass local-game-1p (g:game)
((computer-paddle-target :initarg :computer-paddle-target
:initform nil
:accessor local-game-1p-computer-paddle-target)))
(defclass local-game-2p (g:game) ())
(defclass game-scene (scene) (defclass game-scene (scene)
((game :initarg :game :initform nil :reader game-scene-game) ((game :initarg :game :initform nil :reader game-scene-game)
(left-score :initarg :left-score :initform nil :reader game-scene-left-score) (left-score :initarg :left-score :initform nil :reader game-scene-left-score)
@ -21,13 +10,12 @@
(right-player :initarg :right-player :initform nil :reader game-scene-right-player) (right-player :initarg :right-player :initform nil :reader game-scene-right-player)
(ball :initarg :ball :initform nil :reader game-scene-ball) (ball :initarg :ball :initform nil :reader game-scene-ball)
(line :initarg :line :initform nil :reader game-scene-line) (line :initarg :line :initform nil :reader game-scene-line)
(move-back :initarg :move-back :initform nil :reader game-scene-move-back)
(quit-menu :initarg :quit-menu :initform nil :reader game-scene-quit-menu) (quit-menu :initarg :quit-menu :initform nil :reader game-scene-quit-menu)
(quit-menu-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text) (quit-menu-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text)
(quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes) (quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes)
(quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no))) (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no)))
(defun open-game (game move-back) (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))
@ -109,7 +97,6 @@
:right-player right-player :right-player right-player
:ball ball :ball ball
:line line :line line
:move-back move-back
:quit-menu quit-menu :quit-menu quit-menu
:quit-menu-text quit-menu-text :quit-menu-text quit-menu-text
:quit-menu-yes quit-menu-yes :quit-menu-yes quit-menu-yes
@ -157,16 +144,18 @@
(setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +score-padding+))) (setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +score-padding+)))
(defmethod on-update ((scene game-scene) timelapse) (defmethod on-update ((scene game-scene) timelapse)
(unless (gui:visible (game-scene-quit-menu scene)) (g:on-update (game-scene-game scene) timelapse)
(g:on-update (game-scene-game scene) timelapse))
(update-text-if-hovered (game-scene-quit-menu-yes scene) "Yes") (update-text-if-hovered (game-scene-quit-menu-yes scene) "Yes")
(update-text-if-hovered (game-scene-quit-menu-no scene) "No") (update-text-if-hovered (game-scene-quit-menu-no scene) "No")
(when (gui:clickedp (game-scene-quit-menu-no scene) r:+mouse-button-left+) (when (gui:clickedp (game-scene-quit-menu-no scene) r:+mouse-button-left+)
(g:resume (game-scene-game scene))
(setf (gui:visible (game-scene-quit-menu scene)) nil)) (setf (gui:visible (game-scene-quit-menu scene)) nil))
(when (r:is-key-pressed r:+key-escape+) (when (r:is-key-pressed r:+key-escape+)
(g:pause (game-scene-game scene))
(setf (gui:visible (game-scene-quit-menu scene)) t)) (setf (gui:visible (game-scene-quit-menu scene)) t))
(when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+) (when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+)
(funcall (game-scene-move-back scene)))) (open-main-menu)))
(defmethod on-draw ((scene game-scene)) (defmethod on-draw ((scene game-scene))
(with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no) (with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no)
@ -185,155 +174,3 @@
(setf (gui:text right-player) (g:state-right-player game-state)) (setf (gui:text right-player) (g:state-right-player game-state))
(position-right-player right-player) (position-right-player right-player)
(position-quit-menu quit-menu quit-menu-text quit-menu-yes quit-menu-no)))) (position-quit-menu quit-menu quit-menu-text quit-menu-yes quit-menu-no))))
(defun handle-player-paddle (paddle timelapse upward-keys downward-keys)
(let ((paddle-y (g:paddle-y paddle))
(paddle-vy (g:paddle-vy paddle)))
(setf (g:paddle-vy paddle)
(cond ((member-if #'r:is-key-down downward-keys) g:+paddle-speed+)
((member-if #'r:is-key-down upward-keys) (- g:+paddle-speed+))
(t 0.0)))
(setf (g:paddle-y paddle)
(min (max (+ paddle-y (* paddle-vy timelapse)) (/ g:+paddle-height+ 2))
(- 1.0 (/ g:+paddle-height+ 2))))))
(defun handle-left-player (state timelapse upward-keys downward-keys)
(handle-player-paddle (g:state-left-paddle state) timelapse upward-keys downward-keys))
(defun handle-right-player (state timelapse upward-keys downward-keys)
(handle-player-paddle (g:state-right-paddle state) timelapse upward-keys downward-keys))
(defun handle-right-computer (state timelapse target)
(let* ((right-paddle (g:state-right-paddle state))
(paddle-y (g:paddle-y right-paddle))
(ball (g:state-ball state))
(ball-xy (g:ball-xy ball))
(ball-y (v:vy ball-xy))
(paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2))))))
(setf (g:paddle-vy right-paddle)
(if paddle-target
(let ((delta (/ (- ball-y paddle-target) timelapse)))
(if (minusp delta)
(max delta (- g:+paddle-speed+))
(min delta g:+paddle-speed+)))
0.0))
(setf (g:paddle-y right-paddle)
(min (max (+ paddle-y (* (g:paddle-vy right-paddle) timelapse))
(/ g:+paddle-height+ 2))
(- 1.0 (/ g:+paddle-height+ 2))))))
(defun point-in-rect-p (px py rx ry rw rh)
(and (> px rx)
(< px (+ rx rw))
(> py ry)
(< py (+ ry rh))))
(defun get-ball-paddle-collision (ball paddle paddle-x)
(let* ((ball-xy (g:ball-xy ball))
(ball-x (v:vx ball-xy))
(ball-y (v:vy ball-xy))
(paddle-y (g:paddle-y paddle)))
(when (or (point-in-rect-p (- ball-x g:+ball-radius+)
(- ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (- ball-x g:+ball-radius+)
(+ ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (+ ball-x g:+ball-radius+)
(- ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (+ ball-x g:+ball-radius+)
(+ ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+))
(- ball-y paddle-y))))
(defun handle-ball (state timelapse)
(let* ((ball (g:state-ball state))
(ball-xy (g:ball-xy ball))
(ball-x (v:vx ball-xy))
(ball-y (v:vy ball-xy))
(ball-vxy (g:ball-vxy ball))
(ball-vy (v:vy ball-vxy))
(left-paddle (g:state-left-paddle state))
(right-paddle (g:state-right-paddle state))
(ball-left-paddle-collision
(get-ball-paddle-collision ball left-paddle 0.0))
(ball-right-paddle-collision
(get-ball-paddle-collision ball right-paddle (- 1.0 g:+paddle-width+))))
(cond
(ball-left-paddle-collision
(g:launch-ball ball
(incf (g:state-bounces state))
(* (/ ball-left-paddle-collision
(+ (/ g:+paddle-height+ 2) g:+ball-radius+))
g:+max-launch-angle+)
(+ g:+paddle-width+ g:+ball-radius+)
ball-y))
(ball-right-paddle-collision
(g:launch-ball ball
(incf (g:state-bounces state))
(- pi
(* (/ ball-right-paddle-collision
(+ (/ g:+paddle-height+ 2) g:+ball-radius+))
(/ g:+max-launch-angle+ 2)))
(- 1.0 g:+paddle-width+ g:+ball-radius+)
ball-y))
((< (+ ball-x g:+ball-radius+) 0)
(incf (g:state-right-score state))
(g:random-launch-ball state))
((> (- ball-x g:+ball-radius+) 1)
(incf (g:state-left-score state))
(g:random-launch-ball state))
((< (- ball-y g:+ball-radius+) 0)
(setf (v:vy ball-xy) g:+ball-radius+)
(setf (v:vy ball-vxy) (* -1 ball-vy)))
((> (+ ball-y g:+ball-radius+) 1)
(setf (v:vy ball-xy) (- 1 g:+ball-radius+))
(setf (v:vy ball-vxy) (* -1 ball-vy)))
(t
(setf (g:ball-xy ball) (v:v+ ball-xy (v:v* ball-vxy timelapse)))))))
(defun computer-paddle-target (game)
(let* ((game-state (g:game-state game))
(ball (g:state-ball game-state))
(ball-vxy (g:ball-vxy ball)))
(if (plusp (v:vx ball-vxy))
(or (local-game-1p-computer-paddle-target game)
(setf (local-game-1p-computer-paddle-target game)
(random g:+paddle-height+)))
(setf (local-game-1p-computer-paddle-target game) nil))))
(defmethod g:on-init ((game local-game-1p))
(g:random-launch-ball (g:game-state game)))
(defmethod g:on-update ((game local-game-1p) timelapse)
(let ((game-state (g:game-state game)))
(handle-left-player game-state timelapse
(list r:+key-w+ r:+key-up+)
(list r:+key-s+ r:+key-down+))
(handle-right-computer game-state timelapse (computer-paddle-target game))
(handle-ball game-state timelapse)))
(defmethod g:on-init ((game local-game-2p))
(g:random-launch-ball (g:game-state game)))
(defmethod g:on-update ((game local-game-2p) timelapse)
(let ((game-state (g:game-state game)))
(handle-left-player game-state timelapse (list r:+key-w+) (list r:+key-s+))
(handle-right-player game-state timelapse (list r:+key-up+) (list r:+key-down+))
(handle-ball game-state timelapse)))

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

@ -0,0 +1,168 @@
(in-package :pong.client)
(defclass local-game-1p (g:game)
((computer-paddle-target :initarg :computer-paddle-target
:initform nil
:accessor local-game-1p-computer-paddle-target)))
(defclass local-game-2p (g:game) ())
(defun start-1-player-game ()
(setf *scene* (open-game (make-instance 'local-game-1p))))
(defun start-2-players-game ()
(setf *scene* (open-game (make-instance 'local-game-2p))))
(defun handle-player-paddle (paddle timelapse upward-keys downward-keys)
(let ((paddle-y (g:paddle-y paddle))
(paddle-vy (g:paddle-vy paddle)))
(setf (g:paddle-vy paddle)
(cond ((member-if #'r:is-key-down downward-keys) g:+paddle-speed+)
((member-if #'r:is-key-down upward-keys) (- g:+paddle-speed+))
(t 0.0)))
(setf (g:paddle-y paddle)
(min (max (+ paddle-y (* paddle-vy timelapse)) (/ g:+paddle-height+ 2))
(- 1.0 (/ g:+paddle-height+ 2))))))
(defun handle-left-player (state timelapse upward-keys downward-keys)
(handle-player-paddle (g:state-left-paddle state) timelapse upward-keys downward-keys))
(defun handle-right-player (state timelapse upward-keys downward-keys)
(handle-player-paddle (g:state-right-paddle state) timelapse upward-keys downward-keys))
(defun handle-right-computer (state timelapse target)
(let* ((right-paddle (g:state-right-paddle state))
(paddle-y (g:paddle-y right-paddle))
(ball (g:state-ball state))
(ball-xy (g:ball-xy ball))
(ball-y (v:vy ball-xy))
(paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2))))))
(setf (g:paddle-vy right-paddle)
(if paddle-target
(let ((delta (/ (- ball-y paddle-target) timelapse)))
(if (minusp delta)
(max delta (- g:+paddle-speed+))
(min delta g:+paddle-speed+)))
0.0))
(setf (g:paddle-y right-paddle)
(min (max (+ paddle-y (* (g:paddle-vy right-paddle) timelapse))
(/ g:+paddle-height+ 2))
(- 1.0 (/ g:+paddle-height+ 2))))))
(defun point-in-rect-p (px py rx ry rw rh)
(and (> px rx)
(< px (+ rx rw))
(> py ry)
(< py (+ ry rh))))
(defun get-ball-paddle-collision (ball paddle paddle-x)
(let* ((ball-xy (g:ball-xy ball))
(ball-x (v:vx ball-xy))
(ball-y (v:vy ball-xy))
(paddle-y (g:paddle-y paddle)))
(when (or (point-in-rect-p (- ball-x g:+ball-radius+)
(- ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (- ball-x g:+ball-radius+)
(+ ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (+ ball-x g:+ball-radius+)
(- ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+)
(point-in-rect-p (+ ball-x g:+ball-radius+)
(+ ball-y g:+ball-radius+)
paddle-x
(- paddle-y (/ g:+paddle-height+ 2))
g:+paddle-width+
g:+paddle-height+))
(- ball-y paddle-y))))
(defun handle-ball (state timelapse)
(let* ((ball (g:state-ball state))
(ball-xy (g:ball-xy ball))
(ball-x (v:vx ball-xy))
(ball-y (v:vy ball-xy))
(ball-vxy (g:ball-vxy ball))
(ball-vy (v:vy ball-vxy))
(left-paddle (g:state-left-paddle state))
(right-paddle (g:state-right-paddle state))
(ball-left-paddle-collision
(get-ball-paddle-collision ball left-paddle 0.0))
(ball-right-paddle-collision
(get-ball-paddle-collision ball right-paddle (- 1.0 g:+paddle-width+))))
(cond
(ball-left-paddle-collision
(g:launch-ball ball
(incf (g:state-bounces state))
(* (/ ball-left-paddle-collision
(+ (/ g:+paddle-height+ 2) g:+ball-radius+))
g:+max-launch-angle+)
(+ g:+paddle-width+ g:+ball-radius+)
ball-y))
(ball-right-paddle-collision
(g:launch-ball ball
(incf (g:state-bounces state))
(- pi
(* (/ ball-right-paddle-collision
(+ (/ g:+paddle-height+ 2) g:+ball-radius+))
(/ g:+max-launch-angle+ 2)))
(- 1.0 g:+paddle-width+ g:+ball-radius+)
ball-y))
((< (+ ball-x g:+ball-radius+) 0)
(incf (g:state-right-score state))
(g:random-launch-ball state))
((> (- ball-x g:+ball-radius+) 1)
(incf (g:state-left-score state))
(g:random-launch-ball state))
((< (- ball-y g:+ball-radius+) 0)
(setf (v:vy ball-xy) g:+ball-radius+)
(setf (v:vy ball-vxy) (* -1 ball-vy)))
((> (+ ball-y g:+ball-radius+) 1)
(setf (v:vy ball-xy) (- 1 g:+ball-radius+))
(setf (v:vy ball-vxy) (* -1 ball-vy)))
(t
(setf (g:ball-xy ball) (v:v+ ball-xy (v:v* ball-vxy timelapse)))))))
(defun computer-paddle-target (game)
(let* ((game-state (g:game-state game))
(ball (g:state-ball game-state))
(ball-vxy (g:ball-vxy ball)))
(if (plusp (v:vx ball-vxy))
(or (local-game-1p-computer-paddle-target game)
(setf (local-game-1p-computer-paddle-target game)
(random g:+paddle-height+)))
(setf (local-game-1p-computer-paddle-target game) nil))))
(defmethod g:on-init ((game local-game-1p))
(g:random-launch-ball (g:game-state game)))
(defmethod g:on-update ((game local-game-1p) timelapse)
(let ((game-state (g:game-state game)))
(unless (g:state-paused game-state)
(handle-left-player game-state timelapse
(list r:+key-w+ r:+key-up+)
(list r:+key-s+ r:+key-down+))
(handle-right-computer game-state timelapse (computer-paddle-target game))
(handle-ball game-state timelapse))))
(defmethod g:on-init ((game local-game-2p))
(g:random-launch-ball (g:game-state game)))
(defmethod g:on-update ((game local-game-2p) timelapse)
(let ((game-state (g:game-state game)))
(unless (g:state-paused game-state)
(handle-left-player game-state timelapse (list r:+key-w+) (list r:+key-s+))
(handle-right-player game-state timelapse (list r:+key-up+) (list r:+key-down+))
(handle-ball game-state timelapse))))

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

@ -1,18 +1,5 @@
(in-package :pong.client) (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")
(defclass main-menu (scene) (defclass main-menu (scene)
((title :initarg :title :initform nil :reader main-menu-title) ((title :initarg :title :initform nil :reader main-menu-title)
(items-group :initarg :items-group :initform nil :reader main-menu-items-group) (items-group :initarg :items-group :initform nil :reader main-menu-items-group)
@ -34,7 +21,7 @@
`(make-instance 'menu-item :action ,action `(make-instance 'menu-item :action ,action
:text (gui:make-text ,@text-args))) :text (gui:make-text ,@text-args)))
(defun open-main-menu (start-1-player-game start-2-players-game create-online-game join-online-game) (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+
@ -54,7 +41,7 @@
:font-size +menu-font-size+ :font-size +menu-font-size+
:color +menu-text-color+ :color +menu-text-color+
:h-align :center) :h-align :center)
:action 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+)
@ -63,7 +50,7 @@
:font-size +menu-font-size+ :font-size +menu-font-size+
:color +menu-text-color+ :color +menu-text-color+
:h-align :center) :h-align :center)
:action 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+)
@ -80,7 +67,7 @@
:font-size +menu-font-size+ :font-size +menu-font-size+
:color +menu-text-color+ :color +menu-text-color+
:h-align :center) :h-align :center)
:action create-online-game)) :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+)
@ -89,7 +76,7 @@
:font-size +menu-font-size+ :font-size +menu-font-size+
:color +menu-text-color+ :color +menu-text-color+
:h-align :center) :h-align :center)
:action join-online-game)) :action #'open-create-online-game-scene))
(items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join)) (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join))
(gui:h (menu-item-text online-join))) (gui:h (menu-item-text online-join)))
:h-align :center :h-align :center
@ -105,7 +92,7 @@
(menu-item-text online-create) (menu-item-text online-create)
(menu-item-text online-join)) (menu-item-text online-join))
(gui:add-children root-element title items-group) (gui:add-children root-element title items-group)
(make-main-menu :title title (set-scene (make-main-menu :title title
:items-group items-group :items-group items-group
:local-title local-title :local-title local-title
:local-1-player 1-player :local-1-player 1-player
@ -114,7 +101,7 @@
:online-create online-create :online-create online-create
:online-join online-join :online-join online-join
:items-group items-group :items-group items-group
:root-element root-element))) :root-element root-element))))
(defun position-title (title) (defun position-title (title)
(setf (gui:x title) (floor (gui:w (gui:parent title)) 2))) (setf (gui:x title) (floor (gui:w (gui:parent title)) 2)))

30
client/src/main.lisp
Unescape View File

@ -0,0 +1,30 @@
(in-package :pong.client)
(defun create-online-game ()
(setf *scene* (open-create-online-game-scene)))
(defun join-online-game ()
(format t "~%Join online game."))
(defun main ()
(let* ((last-time nil)
(current-time (get-internal-real-time)))
(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)))))))

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

@ -0,0 +1,55 @@
(in-package :pong.client)
(defclass online-game (g:game)
((actions :initarg :actions :initform nil :accessor online-game-actions)
(keyboard :initform (make-hash-table) :reader online-game-keyboard)
(paddle :initarg :paddle :initform :left :reader online-game-paddle)))
(defun start-online-game (&optional (paddle :left))
(set-scene (open-game (make-instance 'online-game :paddle paddle))))
(defun open-create-online-game-scene ()
(start-online-game :left))
(defmethod g:on-init ((game online-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))))
(defun is-first-key-released-p (key keyboard)
(and (r:is-key-released key) (gethash key keyboard)))
(defun set-key-down (key keyboard)
(setf (gethash key keyboard) (r:is-key-down key)))
(defmethod g:on-update ((game online-game) timelapse)
(with-slots (actions keyboard paddle) game
(when (or (is-first-key-down-p r:+key-s+ keyboard)
(is-first-key-down-p r:+key-down+ keyboard))
(set-key-down r:+key-s+ keyboard)
(set-key-down r:+key-down+ keyboard)
(let ((action (make-instance 'g:start-down-action :paddle paddle)))
(g:apply-action action game)
(push action actions)))
(when (or (is-first-key-released-p r:+key-s+ keyboard)
(is-first-key-released-p r:+key-down+ keyboard))
(set-key-down r:+key-s+ keyboard)
(set-key-down r:+key-down+ keyboard)
(let ((action (make-instance 'g:stop-down-action :paddle paddle)))
(g:apply-action action game)
(push action action)))
(when (or (is-first-key-down-p r:+key-w+ keyboard)
(is-first-key-down-p r:+key-up+ keyboard))
(set-key-down r:+key-w+ keyboard)
(set-key-down r:+key-up+ keyboard)
(let ((action (make-instance 'g:start-up-action :paddle paddle)))
(g:apply-action action game)
(push action actions)))
(when (or (is-first-key-released-p r:+key-w+ keyboard)
(is-first-key-released-p r:+key-up+ keyboard))
(set-key-down r:+key-w+ keyboard)
(set-key-down r:+key-up+ keyboard)
(let ((action (make-instance 'g:stop-up-action :paddle paddle)))
(g:apply-action action game)
(push action actions)))))

5
client/src/scene.lisp
Unescape View File

@ -1,5 +1,7 @@
(in-package #:pong.client) (in-package #:pong.client)
(defparameter *scene* nil)
(defclass scene () (defclass scene ()
((root-element :initarg :root-element ((root-element :initarg :root-element
:initform (make-instance 'gui:element) :initform (make-instance 'gui:element)
@ -13,3 +15,6 @@
(defmethod on-draw :after ((scene scene)) (defmethod on-draw :after ((scene scene))
(gui:draw (scene-root-element scene))) (gui:draw (scene-root-element scene)))
(defun set-scene (scene)
(setf *scene* scene))

5
game/game.asd
Unescape View File

@ -6,9 +6,10 @@
:license "AGPLv3" :license "AGPLv3"
:version "0.0.1" :version "0.0.1"
:serial t :serial t
:depends-on ("3d-vectors") :depends-on ("3d-vectors" "cl-conspack")
:pathname "src" :pathname "src"
:components :components
((:file "package") ((:file "package")
(:file "game"))) (:file "game")
(:file "action")))

55
game/src/action.lisp
Unescape View File

@ -0,0 +1,55 @@
(in-package :pong.game)
(defclass action ()
((timestamp :initarg :timestamp
:initform (/ (get-internal-real-time) internal-time-units-per-second)
:reader action-timestamp)))
(defgeneric apply-action (action game))
(defclass start-game-action (action)
((name :initarg :name :initform nil :accessor name)))
(defclass start-down-action (action)
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass stop-down-action (action)
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass start-up-action (action)
((paddle :initarg :paddle :initform nil :reader paddle)))
(defclass stop-up-action (action)
((paddle :initarg :paddle :initform nil :reader paddle)))
(cpk:defencoding action timestamp)
(cpk:defencoding start-game-action name)
(cpk:defencoding start-down-action paddle)
(cpk:defencoding stop-down-action paddle)
(cpk:defencoding start-up-action paddle)
(cpk:defencoding stop-up-action paddle)
(defun get-paddle (paddle state)
(case paddle
(:left (state-left-paddle state))
(:right (state-right-paddle state))) )
(defmethod apply-action ((action start-down-action) (game game))
(let* ((state (game-state game))
(paddle (get-paddle (paddle action) state)))
(incf (paddle-vy paddle) +paddle-speed+)))
(defmethod apply-action ((action stop-down-action) (game game))
(let* ((state (game-state game))
(paddle (get-paddle (paddle action) state)))
(decf (paddle-vy paddle) +paddle-speed+)))
(defmethod apply-action ((action start-up-action) (game game))
(let* ((state (game-state game))
(paddle (get-paddle (paddle action) state)))
(decf (paddle-vy paddle) +paddle-speed+)))
(defmethod apply-action ((action stop-up-action) (game game))
(let* ((state (game-state game))
(paddle (get-paddle (paddle action) state)))
(incf (paddle-vy paddle) +paddle-speed+)))

105
game/src/game.lisp
Unescape View File

@ -42,8 +42,10 @@
:accessor state-left-player) :accessor state-left-player)
(right-player :initarg :right-player (right-player :initarg :right-player
:initform "Opponent" :initform "Opponent"
:accessor state-right-player))) :accessor state-right-player)
(paused :initarg :paused
:initform nil
:reader state-paused)))
(defclass game () (defclass game ()
((state :initarg :game-state ((state :initarg :game-state
@ -53,6 +55,105 @@
(defgeneric on-update (game timelapse)) (defgeneric on-update (game timelapse))
(defgeneric on-init (game)) (defgeneric on-init (game))
(defun update-paddle (paddle timelapse)
(setf (paddle-y paddle)
(min (max (+ (paddle-y paddle) (* (paddle-vy paddle) timelapse))
(/ +paddle-height+ 2))
(- 1 (/ +paddle-height+ 2)))))
(defun point-in-rect-p (px py rx ry rw rh)
(and (> px rx)
(< px (+ rx rw))
(> py ry)
(< py (+ ry rh))))
(defun get-ball-paddle-collision (ball paddle paddle-x)
(let* ((ball-xy (ball-xy ball))
(ball-x (v:vx ball-xy))
(ball-y (v:vy ball-xy))
(paddle-y (paddle-y paddle)))
(when (or (point-in-rect-p (- ball-x +ball-radius+)
(- ball-y +ball-radius+)
paddle-x
(- paddle-y (/ +paddle-height+ 2))
+paddle-width+
+paddle-height+)
(point-in-rect-p (- ball-x +ball-radius+)
(+ ball-y +ball-radius+)
paddle-x
(- paddle-y (/ +paddle-height+ 2))
+paddle-width+
+paddle-height+)
(point-in-rect-p (+ ball-x +ball-radius+)
(- ball-y +ball-radius+)
paddle-x
(- paddle-y (/ +paddle-height+ 2))
+paddle-width+
+paddle-height+)
(point-in-rect-p (+ ball-x +ball-radius+)
(+ ball-y +ball-radius+)
paddle-x
(- paddle-y (/ +paddle-height+ 2))
+paddle-width+
+paddle-height+))
(- ball-y paddle-y))))
(defun update-ball (state ball left-paddle right-paddle timelapse)
(with-slots (xy vxy) ball
(incf (v:vx xy) (* (v:vx vxy) timelapse))
(incf (v:vy xy) (* (v:vy vxy) timelapse))
(let ((ball-left-paddle-collision
(get-ball-paddle-collision ball left-paddle 0.0))
(ball-right-paddle-collision
(get-ball-paddle-collision ball right-paddle (- 1.0 +paddle-width+))))
(cond
(ball-left-paddle-collision
(launch-ball ball
(incf (state-bounces state))
(* (/ ball-left-paddle-collision
(+ (/ +paddle-height+ 2) +ball-radius+))
+max-launch-angle+)
(+ +paddle-width+ +ball-radius+)
(v:vy xy)))
(ball-right-paddle-collision
(launch-ball ball
(incf (state-bounces state))
(- pi
(* (/ ball-right-paddle-collision
(+ (/ +paddle-height+ 2) +ball-radius+))
(/ +max-launch-angle+ 2)))
(- 1.0 +paddle-width+ +ball-radius+)
(v:vy xy)))
((minusp (+ (v:vx xy) +ball-radius+))
(incf (state-right-score state))
(random-launch-ball state))
((> (- (v:vx xy) +ball-radius+) 1)
(incf (state-left-score state))
(random-launch-ball state))
((minusp (- (v:vy xy) +ball-radius+))
(setf (v:vy xy) (+ (- (v:vy xy)) (* +ball-radius+ 2)))
(setf (v:vy vxy) (- (v:vy vxy))))
((> (+ (v:vy xy) +ball-radius+) 1)
(setf (v:vy xy) (- 2 (v:vy xy) (* +ball-radius+ 2)))
(setf (v:vy vxy) (- (v:vy vxy))))))))
(defmethod on-update :after ((game game) timelapse)
(let* ((state (game-state game))
(left-paddle (state-left-paddle state))
(right-paddle (state-right-paddle state))
(ball (state-ball state))
(paused (state-paused state)))
(unless paused
(update-paddle left-paddle timelapse)
(update-paddle right-paddle timelapse)
(update-ball state ball left-paddle right-paddle timelapse))))
(defmethod pause ((game game))
(setf (slot-value (game-state game) 'paused) t))
(defmethod resume ((game game))
(setf (slot-value (game-state game) 'paused) nil))
(defgeneric handle-action (game action)) (defgeneric handle-action (game action))
(defmethod launch-ball ((ball ball) bounces rad x y) (defmethod launch-ball ((ball ball) bounces rad x y)

15
game/src/package.lisp
Unescape View File

@ -28,6 +28,15 @@
#:+paddle-height+ #:+paddle-height+
#:+paddle-width+ #:+paddle-width+
#:+max-launch-angle+ #:+max-launch-angle+
#:+ball-radius+)) #:+ball-radius+
#:action-timestamp
#:start-game-action
#:start-down-action
#:stop-down-action
#:start-up-action
#:stop-up-action
#:apply-action
#:name
#:state-paused
#:pause
#:resume))

4
server/server.asd
Unescape View File

@ -1,12 +1,12 @@
(require :asdf) (require :asdf)
(asdf:defsystem #:pong.server (asdf:defsystem #:server
:description "Pariatech's Pong game client" :description "Pariatech's Pong game client"
:author "Gabriel Pariat <gabriel@pariatech.com>" :author "Gabriel Pariat <gabriel@pariatech.com>"
:license "AGPLv3" :license "AGPLv3"
:version "0.0.1" :version "0.0.1"
:serial t :serial t
:depends-on ("pong.game") :depends-on ("game" "usocket" "bordeaux-threads")
:pathname "src" :pathname "src"
:components :components
((:file "package") ((:file "package")

75
server/src/server.lisp
Unescape View File

@ -3,3 +3,78 @@
(defclass online-game (game) (defclass online-game (game)
((actions :initarg :actions ((actions :initarg :actions
:initform nil))) :initform nil)))
(defparameter *server* nil)
(defparameter *server-running* nil)
(defparameter *connections* nil)
(defparameter *games* nil)
(defparameter *client-game-map* (make-hash-table))
(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)))
(cpk:encode data :stream stream)
(force-output stream)))
(defun update-games ()
(let ((last-time nil)
(current-time (get-time)))
(loop-while-server-running
(setf last-time current-time)
(setf current-time (get-time))
(let ((timelapse (- current-time last-time)))
(loop for client in *connections*
do (send-data-to-client "hello!" client)))
(sleep .100))))
(defun handle-client (client)
(let* ((stream (usocket:socket-stream client))
(msg (cpk:decode-stream stream)))
(format t "[SERVER] Message echoed: ~a~%" msg)
(cpk:encode msg :stream stream)
(force-output stream)))
(defun open-server-socket (port)
(usocket:socket-listen "127.0.0.1" port :reuse-address t :element-type 'unsigned-byte))
(defun wait-for-sockets-ready (connections)
(usocket:wait-for-input connections :ready-only t :timeout 5))
(defun close-connection (connection)
(usocket:socket-close connection)
(setf *connections* (remove connection *connections*)))
(defun start-server (port)
(unless *server-running*
(setf *server-running* t)
(bt:make-thread #'update-games)
(let* ((server-socket (open-server-socket port)))
(unwind-protect
(loop-while-server-running
(loop for ready in (wait-for-sockets-ready (cons server-socket *connections*))
while *server-running*
do (if (usocket:stream-server-usocket-p ready)
(push (usocket:socket-accept ready) *connections*)
(handler-case (handle-client ready)
(stream-error ()
(format t "Socket closed?~%")
(close-connection ready))
;; (t () (close-connection ready))
))))
(loop for c in (cons server-socket *connections*)
do (close-connection c))
(stop-server)))))
(defun stop-server ()
(setf *server-running* nil))
;; (start-server 54321)
;; (stop-server)

Write Preview
Loading…
Cancel
Save