Gabriel Pariat
2 years ago
commit
9aaf29fbbf
24 changed files with 1041 additions and 0 deletions
Binary file not shown.
@ -0,0 +1,26 @@
@@ -0,0 +1,26 @@
|
||||
(require :asdf) |
||||
|
||||
(asdf:defsystem #:client |
||||
:description "Pariatech's Pong game client" |
||||
:author "Gabriel Pariat <gabriel@pariatech.com>" |
||||
: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"))) |
||||
|
@ -0,0 +1,44 @@
@@ -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) |
@ -0,0 +1,339 @@
@@ -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))) |
@ -0,0 +1,115 @@
@@ -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))) |
||||
|
@ -0,0 +1,12 @@
@@ -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))))) |
@ -0,0 +1,19 @@
@@ -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)) |
@ -0,0 +1,38 @@
@@ -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)) |
@ -0,0 +1,16 @@
@@ -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))) |
@ -0,0 +1,64 @@
@@ -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))) |
||||
|
@ -0,0 +1,183 @@
@@ -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)))) |
@ -0,0 +1,5 @@
@@ -0,0 +1,5 @@
|
||||
(defpackage :pong.client |
||||
(:use :cl) |
||||
(:local-nicknames (:r :raylib) |
||||
(:v :3d-vectors) |
||||
(:g :pong.game))) |
@ -0,0 +1,15 @@
@@ -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))) |
@ -0,0 +1,13 @@
@@ -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))))) |
@ -0,0 +1,14 @@
@@ -0,0 +1,14 @@
|
||||
(require :asdf) |
||||
|
||||
(asdf:defsystem #:game |
||||
:description "Pariatech's Pong game" |
||||
:author "Gabriel Pariat <gabriel@pariatech.com>" |
||||
:license "AGPLv3" |
||||
:version "0.0.1" |
||||
:serial t |
||||
:depends-on ("3d-vectors") |
||||
:pathname "src" |
||||
:components |
||||
((:file "package") |
||||
(:file "game"))) |
||||
|
@ -0,0 +1,69 @@
@@ -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))) |
@ -0,0 +1,33 @@
@@ -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+)) |
||||
|
||||
|
@ -0,0 +1,10 @@
@@ -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*) |
@ -0,0 +1,14 @@
@@ -0,0 +1,14 @@
|
||||
(require :asdf) |
||||
|
||||
(asdf:defsystem #:pong.server |
||||
:description "Pariatech's Pong game client" |
||||
:author "Gabriel Pariat <gabriel@pariatech.com>" |
||||
:license "AGPLv3" |
||||
:version "0.0.1" |
||||
:serial t |
||||
:depends-on ("pong.game") |
||||
:pathname "src" |
||||
:components |
||||
((:file "package") |
||||
(:file "server"))) |
||||
|
@ -0,0 +1,3 @@
@@ -0,0 +1,3 @@
|
||||
(defpackage :pong.server |
||||
(:use :cl) |
||||
(:local-nicknames (:g :pong.game))) |
@ -0,0 +1,5 @@
@@ -0,0 +1,5 @@
|
||||
(in-package :pong.server) |
||||
|
||||
(defclass online-game (game) |
||||
((actions :initarg :actions |
||||
:initform nil))) |
Loading…
Reference in new issue