aboutsummaryrefslogtreecommitdiff
path: root/server/game/game.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'server/game/game.lisp')
-rw-r--r--server/game/game.lisp102
1 files changed, 102 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
+