commit 9aaf29fbbf9eda8d77c40909764d4cb4f650700c Author: Gabriel Pariat Date: Tue Oct 18 17:23:18 2022 -0400 first diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..e69de29 diff --git a/client/assets/ComicMono.ttf b/client/assets/ComicMono.ttf new file mode 100644 index 0000000..9bc7354 Binary files /dev/null and b/client/assets/ComicMono.ttf differ diff --git a/client/client.asd b/client/client.asd new file mode 100644 index 0000000..4b543d9 --- /dev/null +++ b/client/client.asd @@ -0,0 +1,26 @@ +(require :asdf) + +(asdf:defsystem #:client + :description "Pariatech's Pong game client" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("game" "cl-raylib" "3d-vectors") + :pathname "src" + :components + ((:file "package") + (:module "gui" + :serial t + :components ((:file "package") + (:file "gui") + (:file "element") + (:file "rectangle") + (:file "text") + (:file "line"))) + (:file "utils") + (:file "scene") + (:file "main-menu") + (:file "game") + (:file "client"))) + diff --git a/client/src/client.lisp b/client/src/client.lisp new file mode 100644 index 0000000..44d71a6 --- /dev/null +++ b/client/src/client.lisp @@ -0,0 +1,44 @@ +(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) diff --git a/client/src/game.lisp b/client/src/game.lisp new file mode 100644 index 0000000..c7e66ac --- /dev/null +++ b/client/src/game.lisp @@ -0,0 +1,339 @@ +(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) + ((game :initarg :game :initform nil :reader game-scene-game) + (left-score :initarg :left-score :initform nil :reader game-scene-left-score) + (right-score :initarg :right-score :initform nil :reader game-scene-right-score) + (left-paddle :initarg :left-paddle :initform nil :reader game-scene-left-paddle) + (right-paddle :initarg :right-paddle :initform nil :reader game-scene-right-paddle) + (left-player :initarg :left-player :initform nil :reader game-scene-left-player) + (right-player :initarg :right-player :initform nil :reader game-scene-right-player) + (ball :initarg :ball :initform nil :reader game-scene-ball) + (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-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text) + (quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes) + (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no))) + +(defun open-game (game move-back) + (let ((root-element (gui:make-rectangle :color r:+darkgray+ + :h-align :center + :v-align :middle)) + (left-score (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :right + :y +score-padding+)) + (right-score (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :y +score-padding+)) + (left-paddle (gui:make-rectangle :color r:+white+ + :v-align :middle)) + (right-paddle (gui:make-rectangle :color r:+white+ + :h-align :right + :v-align :middle)) + (left-player (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :x +score-padding+ + :y +score-padding+)) + (right-player (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :right + :y +score-padding+)) + (ball (gui:make-rectangle :color r:+white+ + :h-align :center + :v-align :middle)) + (line (gui:make-line :thickness 4 + :color r:+white+)) + (quit-menu (gui:make-rectangle :color r:+black+ + :h-align :center + :v-align :middle + :visible nil)) + (quit-menu-text (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :y +score-padding+ + :h-align :center + :text "Do you really want to quit the game?")) + (quit-menu-yes (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :center + :text "Yes")) + (quit-menu-no (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :center + :text "No"))) + + (gui:add-children quit-menu + quit-menu-text + quit-menu-yes + quit-menu-no) + + (gui:add-children root-element + quit-menu + left-score + right-score + left-paddle + right-paddle + ball + line + left-player + right-player) + + (g:on-init game) + + (make-instance 'game-scene :game game + :root-element root-element + :left-score left-score + :right-score right-score + :left-paddle left-paddle + :right-paddle right-paddle + :left-player left-player + :right-player right-player + :ball ball + :line line + :move-back move-back + :quit-menu quit-menu + :quit-menu-text quit-menu-text + :quit-menu-yes quit-menu-yes + :quit-menu-no quit-menu-no))) + +(defun position-score (el direction) + (setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) +score-padding+))) + +(defun position-paddle (paddle el) + (let ((paddle-y (g:paddle-y paddle)) + (parent (gui:parent el))) + (setf (gui:w el) (* g:+paddle-width+ (gui:w parent))) + (setf (gui:h el) (* g:+paddle-height+ (gui:h parent))) + (setf (gui:y el) (* paddle-y (gui:h parent))))) + +(defun position-right-paddle (paddle el) + (position-paddle paddle el) + (setf (gui:x el) (gui:w (gui:parent el)))) + +(defun position-ball (ball el) + (let ((ball-xy (g:ball-xy ball)) + (parent (gui:parent el))) + (setf (gui:w el) (* g:+ball-radius+ (gui:w parent) 2)) + (setf (gui:h el) (* g:+ball-radius+ (gui:h parent) 2)) + (setf (gui:x el) (* (v:vx ball-xy) (gui:w parent))) + (setf (gui:y el) (* (v:vy ball-xy) (gui:h parent))))) + +(defun position-line (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2)) + (setf (gui:end-x el) (floor (gui:w (gui:parent el)) 2)) + (setf (gui:end-y el) (gui:h (gui:parent el)))) + +(defun position-right-player (el) + (setf (gui:x el) (- (gui:w (gui:parent el)) +score-padding+))) + +(defun position-quit-menu (menu text yes no) + (setf (gui:x menu) (floor (gui:w (gui:parent menu)) 2)) + (setf (gui:y menu) (floor (gui:h (gui:parent menu)) 2)) + (setf (gui:w menu) (+ (gui:w text) (* +score-padding+ 2))) + (setf (gui:x text) (floor (gui:w menu) 2)) + (setf (gui:x yes) (floor (gui:w menu) 3)) + (setf (gui:x no) (floor (gui:w menu) 3/2)) + (setf (gui:y yes) (+ (gui:y text) (gui:h text) +score-padding+)) + (setf (gui:y no) (+ (gui:y text) (gui:h text) +score-padding+)) + (setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +score-padding+))) + +(defmethod on-update ((scene game-scene) timelapse) + (unless (gui:visible (game-scene-quit-menu scene)) + (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-no scene) "No") + (when (gui:clickedp (game-scene-quit-menu-no scene) r:+mouse-button-left+) + (setf (gui:visible (game-scene-quit-menu scene)) nil)) + (when (r:is-key-pressed r:+key-escape+) + (setf (gui:visible (game-scene-quit-menu scene)) t)) + (when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+) + (funcall (game-scene-move-back 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) + scene + (let ((game-state (g:game-state game))) + (position-root root-element) + (setf (gui:text left-score) (format nil "~a" (g:state-left-score game-state))) + (setf (gui:text right-score) (format nil "~a" (g:state-right-score game-state))) + (position-score left-score #'-) + (position-score right-score #'+) + (position-paddle (g:state-left-paddle game-state) left-paddle) + (position-right-paddle (g:state-right-paddle game-state) right-paddle) + (position-ball (g:state-ball game-state) ball) + (position-line line) + (setf (gui:text left-player) (g:state-left-player game-state)) + (setf (gui:text right-player) (g:state-right-player game-state)) + (position-right-player right-player) + (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))) diff --git a/client/src/gui/element.lisp b/client/src/gui/element.lisp new file mode 100644 index 0000000..073ca4f --- /dev/null +++ b/client/src/gui/element.lisp @@ -0,0 +1,115 @@ +(in-package #:gui) + +(defclass element () + ((x :initarg :x :initform 0.0 :accessor x) + (y :initarg :y :initform 0.0 :accessor y) + (w :initarg :w :initform 0.0 :accessor w) + (h :initarg :h :initform 0.0 :accessor h) + (h-align :initarg :h-align :initform :left :accessor h-align) + (v-align :initarg :v-align :initform :top :accessor v-align) + (offset-x :initarg :offset-x :initform 0.0 :reader offset-x) + (offset-y :initarg :offset-y :initform 0.0 :reader offset-y) + (screen-x :initarg :screen-x :initform 0.0 :reader screen-x) + (screen-y :initarg :screen-y :initform 0.0 :reader screen-y) + (visible :initarg :visible :initform t :accessor visible) + (parent :initarg :parent :initform nil :reader parent) + (children :initarg :children :initform nil :reader children))) + +(defmethod hoveredp ((el element)) + (let ((mpos (r:get-mouse-position))) + (with-slots (screen-x screen-y w h) el + (and (< (v:vx mpos) (+ screen-x w)) + (>= (v:vx mpos) screen-x) + (< (v:vy mpos) (+ screen-y h)) + (>= (v:vy mpos) screen-y))))) + +(defmethod clickedp ((el element) button) + (and (r:is-mouse-button-pressed button) + (hoveredp el))) + +(defmethod set-screen-x ((el element) x) + (setf (slot-value el 'screen-x) x) + (mapc (lambda (el) (set-screen-x el (+ x (offset-x el)))) + (children el))) + +(defun update-x (el) + (with-slots (x w h-align offset-x screen-x) el + (incf screen-x (- offset-x)) + (setf offset-x (case h-align + (:center (- x (floor w 2))) + (:right (- x w)) + (otherwise x))) + (set-screen-x el (+ screen-x offset-x)))) + +(defmethod (setf x) (value (el element)) + (setf (slot-value el 'x) value) + (update-x el)) + +(defmethod (setf w) (value (el element)) + (setf (slot-value el 'w) value) + (unless (eq (slot-value el 'h-align) :left) + (update-x el))) + +(defmethod (setf h-align) (value (el element)) + (setf (slot-value el 'h-align) value) + (update-x el)) + +(defmethod set-screen-y ((el element) y) + (setf (slot-value el 'screen-y) y) + (mapc (lambda (el) (set-screen-y el (+ y (offset-y el)))) + (children el))) + +(defun update-y (el) + (with-slots (y h v-align offset-y screen-y) el + (incf screen-y (- offset-y)) + (setf offset-y (case v-align + (:middle (- y (floor h 2))) + (:bottom (- y h)) + (otherwise y))) + (set-screen-y el (+ screen-y offset-y)))) + +(defmethod (setf y) (value (el element)) + (setf (slot-value el 'y) value) + (update-y el)) + +(defmethod (setf h) (value (el element)) + (setf (slot-value el 'h) value) + (unless (eq (slot-value el 'v-align) :top) + (update-y el))) + +(defmethod (setf v-align) (value (el element)) + (setf (slot-value el 'v-align) value) + (update-y el)) + +(defmethod remove-child ((parent element) (child element)) + (setf (slot-value parent 'children) + (remove child (children parent)))) + +(defmethod remove-children ((parent element) &rest children) + (mapc #'(lambda (child) (remove-child parent child)) children)) + +(defmethod add-child ((parent element) (child element)) + (when (parent child) + (remove-child (parent child) child)) + (push child (slot-value parent 'children)) + (setf (slot-value child 'parent) parent)) + +(defmethod add-children ((parent element) &rest children) + (mapc #'(lambda (child) (add-child parent child)) children)) + +(defmethod calculate-size ((el element))) + +(defmethod update ((el element)) + (calculate-size el) + (update-y el) + (update-x el) + el) + +(defmethod draw ((el element))) +(defmethod draw :after ((el element)) + (when (visible el) + (mapc #'draw (children el)))) + +(defmacro make-element (&rest args) + `(update (make-instance 'element ,@args))) + diff --git a/client/src/gui/gui.lisp b/client/src/gui/gui.lisp new file mode 100644 index 0000000..e8aeb7a --- /dev/null +++ b/client/src/gui/gui.lisp @@ -0,0 +1,12 @@ +(in-package #:gui) + +(defparameter *fonts* nil) + +(defmacro with-gui (&body body) + `(unwind-protect + (progn + (setf *fonts* (make-hash-table :test #'equal)) + ,@body) + (loop for v being the hash-value in *fonts* + do (loop for v being the hash-value in v + do (r:unload-font v))))) diff --git a/client/src/gui/line.lisp b/client/src/gui/line.lisp new file mode 100644 index 0000000..c705dc1 --- /dev/null +++ b/client/src/gui/line.lisp @@ -0,0 +1,19 @@ +(in-package #:gui) + +(defclass line (element) + ((end-x :initarg :end-x :initform 0.0 :accessor end-x) + (end-y :initarg :end-y :initform 0.0 :accessor end-y) + (thickness :initarg :thickness :initform 0.0 :accessor thickness) + (color :initarg :color :initform r:+black+ :accessor color))) + +(defmethod draw ((line line)) + (with-slots (screen-x screen-y x y end-x end-y thickness color visible) line + (when visible + (r:draw-line-ex (v:vec screen-x screen-y) + (v:vec (+ screen-x (- end-x x)) + (+ screen-y (- end-y y))) + (float thickness) + color)))) + +(defmacro make-line (&rest args) + `(make-instance 'line ,@args)) diff --git a/client/src/gui/package.lisp b/client/src/gui/package.lisp new file mode 100644 index 0000000..9e97305 --- /dev/null +++ b/client/src/gui/package.lisp @@ -0,0 +1,38 @@ +(defpackage #:gui + (:use :cl) + (:local-nicknames (:r :raylib) + (:v :3d-vectors)) + (:export #:element + #:rectangle + #:text + #:line + #:x + #:y + #:w + #:h + #:h-align + #:v-align + #:offset-x + #:offset-y + #:screen-x + #:screen-y + #:end-x + #:end-y + #:thickness + #:color + #:parent + #:children + #:visible + #:draw + #:hoveredp + #:clickedp + #:remove-child + #:remove-children + #:add-child + #:add-children + #:update + #:make-element + #:make-text + #:make-rectangle + #:make-line + #:with-gui)) diff --git a/client/src/gui/rectangle.lisp b/client/src/gui/rectangle.lisp new file mode 100644 index 0000000..a7a1965 --- /dev/null +++ b/client/src/gui/rectangle.lisp @@ -0,0 +1,16 @@ +(in-package #:gui) + +(defclass rectangle (element) + ((color :initarg :color :initform r:+black+ :accessor color))) + +(defmethod draw ((rect rectangle)) + (with-slots (screen-x screen-y w h color visible) rect + (when visible + (r:draw-rectangle (floor screen-x) + (floor screen-y) + (floor w) + (floor h) + color)))) + +(defmacro make-rectangle (&rest args) + `(update (make-instance 'rectangle ,@args))) diff --git a/client/src/gui/text.lisp b/client/src/gui/text.lisp new file mode 100644 index 0000000..b359147 --- /dev/null +++ b/client/src/gui/text.lisp @@ -0,0 +1,64 @@ +(in-package #:gui) + + +(defclass text (element) + ((w :initarg :w :initform 0.0 :reader w) + (h :initarg :h :initform 0.0 :reader h) + (text :initarg :text :initform "" :accessor text) + (color :initarg :color :initform r:+black+ :accessor color) + (font :initarg :font :initform nil :accessor font) + (font-size :initarg :font-size :initform 32 :accessor font-size) + (spacing :initarg :spacing :initform 1.0 :accessor spacing))) + +(defun load-font (font font-size) + (let ((font-family (or (gethash font *fonts*) + (setf (gethash font *fonts*) (make-hash-table))))) + (or (gethash font-size font-family) + (setf (gethash font-size font-family) + (r:load-font-ex font font-size (cffi:null-pointer) 0))))) + +(defmethod draw ((text text)) + (with-slots (font font-size text screen-x screen-y color spacing visible) text + (when visible + (r:draw-text-ex (load-font font font-size) + text + (v:vec (float screen-x) (float screen-y)) + (float font-size) + spacing + color)))) + +(defmethod calculate-size ((txt text)) + (with-slots (w h font font-size text spacing) txt + (when font + (let ((size (r:measure-text-ex (load-font font font-size) + text + (float font-size) + spacing))) + (setf w (v:vx size)) + (setf h (v:vy size)) + (update-x txt) + (update-y txt))))) + +(defmethod (setf text) (value (txt text)) + (setf (slot-value txt 'text) value) + (update txt)) + +(defmethod (setf font) (value (txt text)) + (setf (slot-value txt 'font) value) + (update txt)) + +(defmethod (setf font) (value (txt text)) + (setf (slot-value txt 'font) value) + (update txt)) + +(defmethod (setf font-size) (value (txt text)) + (setf (slot-value txt 'font-size) value) + (update txt)) + +(defmethod (setf spacing) (value (txt text)) + (setf (slot-value txt 'spacing) value) + (update txt)) + +(defmacro make-text (&rest args) + `(update (make-instance 'text ,@args))) + diff --git a/client/src/main-menu.lisp b/client/src/main-menu.lisp new file mode 100644 index 0000000..d736e32 --- /dev/null +++ b/client/src/main-menu.lisp @@ -0,0 +1,183 @@ +(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) + ((title :initarg :title :initform nil :reader main-menu-title) + (items-group :initarg :items-group :initform nil :reader main-menu-items-group) + (local-title :initarg :local-title :initform nil :reader main-menu-local-title) + (local-1-player :initarg :local-1-player :initform nil :reader main-menu-local-1-player) + (local-2-players :initarg :local-2-players :initform nil :reader main-menu-local-2-players) + (online-title :initarg :online-title :initform nil :reader main-menu-online-title) + (online-create :initarg :online-create :initform nil :reader main-menu-online-create) + (online-join :initarg :online-join :initform nil :reader main-menu-online-join))) + +(defmacro make-main-menu (&rest args) + `(make-instance 'main-menu ,@args)) + +(defclass menu-item () + ((text :initarg :text :initform nil :reader menu-item-text) + (action :initarg :action :initform nil :reader menu-item-action))) + +(defmacro make-menu-item ((&rest text-args) &key action) + `(make-instance 'menu-item :action ,action + :text (gui:make-text ,@text-args))) + +(defun open-main-menu (start-1-player-game start-2-players-game create-online-game join-online-game) + (let* ((title (gui:make-text :text "Pariatech's Pong Game" + :font +menu-font+ + :font-size +menu-title-font-size+ + :color +menu-text-color+ + :y +title-top-padding+ + :h-align :center)) + (local-title (gui:make-text :text "Local" + :font +menu-font+ + :font-size +menu-group-title-font-size+ + :color +menu-text-color+ + :h-align :center)) + (1-player (make-menu-item (:y (+ (gui:y local-title) + (gui:h local-title) + +menu-group-padding+) + :text +menu-local-1-player+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action start-1-player-game)) + (2-players (make-menu-item (:y (+ (gui:y (menu-item-text 1-player)) + (gui:h (menu-item-text 1-player)) + +menu-padding+) + :text +menu-local-2-players+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action start-2-players-game)) + (online-title (gui:make-text :y (+ (gui:y (menu-item-text 2-players)) + (gui:h (menu-item-text 2-players)) + +menu-group-padding+) + :text "Online" + :font +menu-font+ + :font-size +menu-group-title-font-size+ + :color +menu-text-color+ + :h-align :center)) + (online-create (make-menu-item (:y (+ (gui:y online-title) + (gui:h online-title) + +menu-group-padding+) + :text +menu-online-create+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action create-online-game)) + (online-join (make-menu-item (:y (+ (gui:y (menu-item-text online-create)) + (gui:h (menu-item-text online-create)) + +menu-padding+) + :text +menu-online-join+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action join-online-game)) + (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join)) + (gui:h (menu-item-text online-join))) + :h-align :center + :v-align :middle)) + (root-element (gui:make-rectangle :color r:+darkgray+ + :h-align :center + :v-align :middle))) + (gui:add-children items-group + local-title + (menu-item-text 1-player) + (menu-item-text 2-players) + online-title + (menu-item-text online-create) + (menu-item-text online-join)) + (gui:add-children root-element title items-group) + (make-main-menu :title title + :items-group items-group + :local-title local-title + :local-1-player 1-player + :local-2-players 2-players + :online-title online-title + :online-create online-create + :online-join online-join + :items-group items-group + :root-element root-element))) + +(defun position-title (title) + (setf (gui:x title) (floor (gui:w (gui:parent title)) 2))) + +(defun position-items-group (items-group) + (setf (gui:x items-group) (floor (gui:w (gui:parent items-group)) 2)) + (setf (gui:y items-group) (floor (gui:h (gui:parent items-group)) 2)) + (flet ((find-widest (children) + (let ((widest (car children))) + (dolist (child (cdr children) widest) + (when (> (gui:w child) (gui:w widest)) + (setf widest child))) + widest))) + (setf (gui:w items-group) (gui:w (find-widest (gui:children items-group)))))) + +(defun position-local-title (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-local-1-player (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-local-2-players (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-title (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-create (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-join (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun update-text-if-hovered (el txt) + (setf (gui:text el) + (if (gui:hoveredp el) + (concatenate 'string "> " txt " <") + txt))) + +(defun act-on-click (item) + (when (gui:clickedp (menu-item-text item) r:+mouse-button-left+) + (funcall (menu-item-action item)))) + +(defmethod on-update ((scene main-menu) timelapse) + (with-slots (local-1-player local-2-players online-create online-join) scene + (update-text-if-hovered (menu-item-text local-1-player) +menu-local-1-player+) + (update-text-if-hovered (menu-item-text local-2-players) +menu-local-2-players+) + (update-text-if-hovered (menu-item-text online-create) +menu-online-create+) + (update-text-if-hovered (menu-item-text online-join) +menu-online-join+) + (act-on-click local-1-player) + (act-on-click local-2-players) + (act-on-click online-create) + (act-on-click online-join) + (setf (scene-should-close scene) (r:is-key-pressed r:+key-escape+)))) + +(defmethod on-draw ((scene main-menu)) + (with-slots (root-element title items-group local-title local-1-player local-2-players online-title online-create online-join) scene + (position-root root-element) + (position-title title) + (position-items-group items-group) + (position-local-title local-title) + (position-local-1-player (menu-item-text local-1-player)) + (position-local-2-players (menu-item-text local-2-players)) + (position-online-title online-title) + (position-online-create (menu-item-text online-create)) + (position-online-join (menu-item-text online-join)))) diff --git a/client/src/package.lisp b/client/src/package.lisp new file mode 100644 index 0000000..4a18167 --- /dev/null +++ b/client/src/package.lisp @@ -0,0 +1,5 @@ +(defpackage :pong.client + (:use :cl) + (:local-nicknames (:r :raylib) + (:v :3d-vectors) + (:g :pong.game))) diff --git a/client/src/scene.lisp b/client/src/scene.lisp new file mode 100644 index 0000000..d9b26ec --- /dev/null +++ b/client/src/scene.lisp @@ -0,0 +1,15 @@ +(in-package #:pong.client) + +(defclass scene () + ((root-element :initarg :root-element + :initform (make-instance 'gui:element) + :reader scene-root-element) + (should-close :initarg :should-close + :initform nil + :accessor scene-should-close))) + +(defgeneric on-draw (scene)) +(defgeneric on-update (scene timelapse)) + +(defmethod on-draw :after ((scene scene)) + (gui:draw (scene-root-element scene))) diff --git a/client/src/utils.lisp b/client/src/utils.lisp new file mode 100644 index 0000000..7428d63 --- /dev/null +++ b/client/src/utils.lisp @@ -0,0 +1,13 @@ +(in-package :pong.client) + +(defun position-root (root) + (let* ((sw (r:get-screen-width)) + (sh (r:get-screen-height))) + (setf (gui:x root) (floor sw 2)) + (setf (gui:y root) (floor sh 2)) + (cond ((<= sw sh) + (setf (gui:w root) sw) + (setf (gui:h root) sw)) + (t + (setf (gui:w root) sh) + (setf (gui:h root) sh))))) diff --git a/client/system-index.txt b/client/system-index.txt new file mode 100644 index 0000000..7d1e9af --- /dev/null +++ b/client/system-index.txt @@ -0,0 +1 @@ +client.asd diff --git a/game/game.asd b/game/game.asd new file mode 100644 index 0000000..4ab2bff --- /dev/null +++ b/game/game.asd @@ -0,0 +1,14 @@ +(require :asdf) + +(asdf:defsystem #:game + :description "Pariatech's Pong game" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("3d-vectors") + :pathname "src" + :components + ((:file "package") + (:file "game"))) + diff --git a/game/src/game.lisp b/game/src/game.lisp new file mode 100644 index 0000000..3d5a84c --- /dev/null +++ b/game/src/game.lisp @@ -0,0 +1,69 @@ +(in-package :pong.game) + +(defconstant +paddle-speed+ 0.4) +(defconstant +paddle-height+ 0.1) +(defconstant +paddle-width+ 0.02) +(defconstant +ball-radius+ 0.01) +(defconstant +max-launch-angle+ (/ pi 4)) ; 45° +(defconstant +ball-speed+ 0.5) + +(defstruct paddle + (y 0.0 :type float) + (vy 0.0 :type float)) + +(defstruct ball + (xy (make-instance 'v:vec2) :type v:vec2) + (vxy (make-instance 'v:vec2) :type v:vec2)) + +(defclass state () + ((timestamp :initarg :timestamp + :initform (/ (get-internal-real-time) internal-time-units-per-second) + :reader state-timestamp) + (left-paddle :initarg :left-paddle + :initform (make-paddle :y 0.5) + :accessor state-left-paddle) + (right-paddle :initarg :right-paddle + :initform (make-paddle :y 0.5) + :accessor state-right-paddle) + (ball :initarg :ball + :initform (make-ball :xy (v:vec2 0.5 0.5)) + :accessor state-ball) + (bounces :initarg :bounces + :initform 0 + :accessor state-bounces) + (left-score :initarg :left-score + :initform 0 + :accessor state-left-score) + (right-score :initarg :right-score + :initform 0 + :accessor state-right-score) + (left-player :initarg :left-player + :initform "You" + :accessor state-left-player) + (right-player :initarg :right-player + :initform "Opponent" + :accessor state-right-player))) + + +(defclass game () + ((state :initarg :game-state + :initform (make-instance 'state) + :accessor game-state))) + +(defgeneric on-update (game timelapse)) +(defgeneric on-init (game)) + +(defgeneric handle-action (game action)) + +(defmethod launch-ball ((ball ball) bounces rad x y) + (let* ((v (v:v* (v:vec (cos rad) (sin rad)) (* (log (+ bounces 2)) +ball-speed+)))) + (with-slots (xy vxy) ball + (setf xy (v:vec x y)) + (setf vxy v)))) + +(defmethod random-launch-ball ((state state)) + (launch-ball (state-ball state) + (setf (state-bounces state) 0) + (+ (random +max-launch-angle+) (* (random 2) pi)) + 0.5 + (random 1.0))) diff --git a/game/src/package.lisp b/game/src/package.lisp new file mode 100644 index 0000000..bcab310 --- /dev/null +++ b/game/src/package.lisp @@ -0,0 +1,33 @@ +(defpackage :pong.game + (:use :cl) + (:local-nicknames (:v :3d-vectors)) + (:export #:paddle + #:ball + #:state + #:game + #:on-update + #:on-init + #:handle-action + #:launch-ball + #:random-launch-ball + #:game-state + #:state-timestamp + #:state-left-paddle + #:state-right-paddle + #:state-left-score + #:state-right-score + #:state-ball + #:state-bounces + #:state-left-player + #:state-right-player + #:ball-xy + #:ball-vxy + #:paddle-y + #:paddle-vy + #:+paddle-speed+ + #:+paddle-height+ + #:+paddle-width+ + #:+max-launch-angle+ + #:+ball-radius+)) + + diff --git a/init.lisp b/init.lisp new file mode 100644 index 0000000..d3a0045 --- /dev/null +++ b/init.lisp @@ -0,0 +1,10 @@ +(in-package :cl-user) + +(ql:quickload "cffi") + +(pushnew (car (directory ".")) ql:*local-project-directories*) +(pushnew (car (directory "./client")) ql:*local-project-directories*) + +(ql:register-local-projects) + +(pushnew #P"/usr/local/lib/" cffi:*foreign-library-directories*) diff --git a/server/server.asd b/server/server.asd new file mode 100644 index 0000000..c92a65a --- /dev/null +++ b/server/server.asd @@ -0,0 +1,14 @@ +(require :asdf) + +(asdf:defsystem #:pong.server + :description "Pariatech's Pong game client" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("pong.game") + :pathname "src" + :components + ((:file "package") + (:file "server"))) + diff --git a/server/src/package.lisp b/server/src/package.lisp new file mode 100644 index 0000000..da8abaa --- /dev/null +++ b/server/src/package.lisp @@ -0,0 +1,3 @@ +(defpackage :pong.server + (:use :cl) + (:local-nicknames (:g :pong.game))) diff --git a/server/src/server.lisp b/server/src/server.lisp new file mode 100644 index 0000000..24d028d --- /dev/null +++ b/server/src/server.lisp @@ -0,0 +1,5 @@ +(in-package :pong.server) + +(defclass online-game (game) + ((actions :initarg :actions + :initform nil))) diff --git a/system-index.txt b/system-index.txt new file mode 100644 index 0000000..b083507 --- /dev/null +++ b/system-index.txt @@ -0,0 +1,3 @@ +game/game.asd +client/client.asd +server/server.asd