first

client/client.asd

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

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)

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

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

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

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

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

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

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

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

client/src/package.lisp

@@ -0,0 +1,5 @@
+(defpackage :pong.client
+  (:use :cl)
+  (:local-nicknames (:r :raylib)
+		    (:v :3d-vectors)
+		    (:g :pong.game)))

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

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

client/system-index.txt

@@ -0,0 +1 @@
+client.asd

game/game.asd

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

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

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

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

server/server.asd

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

server/src/package.lisp

@@ -0,0 +1,3 @@
+(defpackage :pong.server
+  (:use :cl)
+  (:local-nicknames (:g :pong.game)))

server/src/server.lisp

@@ -0,0 +1,5 @@
+(in-package :pong.server)
+
+(defclass online-game (game)
+  ((actions :initarg :actions
+	    :initform nil)))

system-index.txt

@@ -0,0 +1,3 @@
+game/game.asd
+client/client.asd
+server/server.asd