Add server submodule

2 files changed, 136 insertions, 0 deletions

diff --git a/server/game/game.lisp b/server/game/game.lisp
new file mode 100644
index 0000000..f909f36
--- /dev/null
+++ b/server/game/game.lisp
@@ -0,0 +1,102 @@
+(in-package :remote-snake-server-game)
+
+(defclass game ()
+  ((initial-size
+    :initarg :initial-size
+    :initform 3)
+   (initial-position
+    :initarg :initial-position
+    :initform (list 0 0))
+   (snake
+    :accessor snake)
+   (dir
+    :initarg :initial-direction
+    :initform :right)
+   (grid-size
+    :initarg :grid-size
+    :initform (list 30 30))
+   (food
+    :initform (make-list 0))
+   (game-over
+    :initform nil
+    :accessor game-over)))
+
+;;; Class constructor to initialize the snake
+(defmethod initialize-instance :after ((g game) &key)
+  (with-slots (snake initial-size initial-position) g
+  (setf snake (make-list initial-size :initial-element initial-position))))
+
+;;; Pretty-print a game
+(defmethod print-object ((g game) stream)
+  (with-slots (snake dir food) g
+    (format t "Snake:      ")
+    (dotimes (i (length snake))
+      (let ((elem (nth i snake)))
+        (unless (eql i 0)
+          (format t "<="))
+        (format t "(~a,~a)" (first elem) (second elem))))
+    (format t "~%Size:       ~a" (length snake))
+    (format t "~%Direction:  ~a" dir)
+    (format t "~%Food:  ~a" food)))
+
+;;; Note that there is no waranty that nb food are added (ex: if food position collide with snake position)
+(defgeneric add-food (g nb)
+  (:documentation "Add food on the game grid."))
+
+(defgeneric refresh (g &key)
+  (:documentation "Refresh the game g (move forward or change direction)."))    
+
+(defmethod refresh ((g game) &key (dir nil dir-supplied-p))
+  ;; First, update direction
+  (with-slots ((active-dir dir)) g
+      (when dir-supplied-p
+        (if (and
+             (or (eq dir :up) (eq dir :down) (eq dir :left) (eq dir :right))
+             (legal-move active-dir dir))
+                 (setf (slot-value g 'dir) dir)
+                 (error "Invalid direction supplied"))))
+  ;; Then, move the snake
+  (with-slots (snake dir) g
+    (let ((last-old-x nil) (last-old-y nil))
+      (dotimes (i (length snake))
+        (let ((elem (nth i snake)))
+          (let ((x (first elem)) (y (second elem)))
+            ;; Move snake
+            (if (eql i 0) ; Move head
+                (progn
+                  ;; Update last-old-x and last-old-y (to move the body when i>0)
+                  (setf last-old-x x)
+                  (setf last-old-y y)
+                  (cond ((eq dir :up) (incf y))
+                        ((eq dir :down) (decf y))
+                        ((eq dir :left) (decf x))
+                        ((eq dir :right) (incf x))))
+              (progn ; Move body
+                  (rotatef x last-old-x)
+                  (rotatef y last-old-y)))
+            (setf (nth i snake) (list x y))))))) ; Apply new snake location (update snake slot)
+  ;; Check if snake eat something
+  (with-slots (snake food) g
+    (unless (eql (member (nth 0 snake) food :test #'equal-coord) nil)
+      (setf food (remove-coord food (nth 0 snake))) ; Remove eated food
+      (setf snake (grow-snake snake 1)))) ; Grow snake of 1 unit
+  ;; Update food
+  (with-slots (food) g
+    (when (< (length food) 1) ; For the moment, allow only one food on the map
+      (add-food g 1)))
+  ;; Check if we loose
+  (with-slots (snake game-over) g
+    (when (member (nth 0 snake) (cdr snake) :test #'equal-coord) ; If head is member of body :D
+      (setf game-over t))))
+
+(defmethod add-food ((g game) nb)
+  (with-slots (snake grid-size food) g
+    (let ((size-x (first grid-size))
+          (size-y (second grid-size)))
+      (dotimes (i nb)
+        (let ((x (random size-x))
+              (y (random size-y)))
+          (when (eq (member (list x y) snake :test #'equal-coord) nil) ; Add if there is no conflict between snake and food position
+            (setf food (append food `(,(list x y))))))))
+    (setf food (remove-duplicates food :test #'equal-coord)))) ; Just in case two food are on the same coordinate
+    
diff --git a/server/game/utils.lisp b/server/game/utils.lisp
new file mode 100644
index 0000000..de05add
--- /dev/null
+++ b/server/game/utils.lisp
@@ -0,0 +1,34 @@
+(in-package :remote-snake-server-game)
+
+;;; Return true when doing a legal move (ex: snake can goto left when it is in the right direction)
+(defun legal-move (active-dir dir)
+  (or
+   (eq active-dir dir) ; Goto same direction
+   (and (or (eq dir :up) (eq dir :down)) ; Got up or down only if the snake is on the left or right direction
+        (or (eq active-dir :left) (eq active-dir :right)))
+   (and (or (eq dir :left) (eq dir :right)) ; Goto left or right only if the snake is on the up or down direction
+        (or (eq active-dir :up) (eq active-dir :down)))))
+
+;;; Grow snake of grow-size amount (snake is growing by the tail)
+(defun grow-snake (snake grow-size)
+  (let* ((old-size (length snake))
+         (new-size (+ old-size grow-size))
+         (tail (nth (- old-size 1) snake))
+         (new-tail (make-list grow-size :initial-element tail)))
+    (append snake new-tail)))
+
+;;; Function to compare two list of two elements
+(defun equal-coord (c1 c2)
+  (let ((x1 (car c1))
+        (x2 (car c2))
+        (y1 (car (cdr c1)))
+        (y2 (car (cdr c2))))
+    (and (eql x1 x2) (eql y1 y2))))
+
+;; Remove a coord from a list of coord (usefull when snake is eating a food)
+(defun remove-coord (l c)
+  (if (eql l '()) l ; Terminal condition
+    (let ((head (first l)))
+      (if (equal-coord head c)
+          (remove-coord (cdr l) c)
+        (append `(,head) (remove-coord (cdr l) c))))))