16 changed files with 675 additions and 251 deletions
@ -1,44 +1,65 @@
@@ -1,44 +1,65 @@
|
||||
(in-package :pong.client) |
||||
|
||||
(defparameter *scene* nil) |
||||
|
||||
(defun open-main-menu% () |
||||
(setf *scene* (open-main-menu #'start-1-player-game |
||||
#'start-2-players-game |
||||
#'create-online-game |
||||
#'join-online-game))) |
||||
|
||||
(defun start-1-player-game () |
||||
(setf *scene* (open-game (make-instance 'local-game-1p) #'open-main-menu%))) |
||||
|
||||
(defun start-2-players-game () |
||||
(setf *scene* (open-game (make-instance 'local-game-2p) #'open-main-menu%))) |
||||
|
||||
(defun create-online-game () |
||||
(format t "~%Create online game.")) |
||||
(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))))))) |
||||
|
||||
(main) |
||||
(defparameter *client* nil) |
||||
|
||||
(defclass client () |
||||
((ip :initarg :ip :initform nil :reader client-ip) |
||||
(port :initarg :port :initform nil :reader client-port) |
||||
(running-p :initform nil :accessor client-running-p) |
||||
(socket :initform nil :accessor client-socket))) |
||||
|
||||
(defmethod listen-to ((self client)) |
||||
(with-slots (running-p socket) self |
||||
(when (and running-p (usocket:wait-for-input socket :timeout 5) running-p) |
||||
(let ((data (cpk:decode-stream (usocket:socket-stream socket)))) |
||||
(format t "[CLIENT] Data received: ~a~%" data))))) |
||||
|
||||
(defmethod start ((self client)) |
||||
(with-slots (ip port running-p socket) self |
||||
(format t "uh?~%") |
||||
(unless running-p |
||||
(setf running-p t) |
||||
(setf socket (usocket:socket-connect ip port :element-type 'unsigned-byte))))) |
||||
|
||||
(defmethod stop ((self client)) |
||||
(with-slots (running-p socket) self |
||||
(setf running-p nil) |
||||
(when socket |
||||
(usocket:socket-close socket)) |
||||
(setf socket nil))) |
||||
|
||||
(defmethod write-to ((self client) data) |
||||
(let ((stream (usocket:socket-stream (client-socket self)))) |
||||
(format t "[CLIENT] Data sent: ~a~%" data) |
||||
(cpk:encode data :stream stream) |
||||
(force-output stream))) |
||||
|
||||
(defun handle-client () |
||||
(loop while (and *client* (client-running-p *client*)) |
||||
do (let ((data (listen-to *client*)))))) |
||||
|
||||
(defun start-client (ip port) |
||||
(unless *client* |
||||
(setf *client* (make-instance 'client :ip ip :port port)) |
||||
(start *client*) |
||||
(bt:make-thread #'handle-client))) |
||||
|
||||
(defun stop-client () |
||||
(when *client* |
||||
(stop *client*)) |
||||
(setf *client* nil)) |
||||
|
||||
(defun send-data-to-server (data) |
||||
(write-to *client* data)) |
||||
|
||||
(defun test-client () |
||||
(start-client "127.0.0.1" 54321) |
||||
(write-to *client* "hello!") |
||||
(sleep 1.015) |
||||
(write-to *client* "bye!") |
||||
(stop-client)) |
||||
|
||||
;; (test-client) |
||||
|
||||
;; (stop-client) |
||||
|
||||
|
||||
@ -0,0 +1,17 @@
@@ -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") |
||||
@ -0,0 +1,59 @@
@@ -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)))) |
||||
@ -0,0 +1,168 @@
@@ -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)))) |
||||
@ -0,0 +1,30 @@
@@ -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))))))) |
||||
@ -0,0 +1,55 @@
@@ -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))))) |
||||
@ -0,0 +1,55 @@
@@ -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+))) |
||||
Loading…
Reference in new issue