77 lines
2.9 KiB
Common Lisp
77 lines
2.9 KiB
Common Lisp
(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)))
|
|
|
|
;;; Class constructor to initialize the snake
|
|
(defmethod initialize-instance :after ((g game) &key)
|
|
(with-slots (snake initial-size initial-position) g
|
|
(setf snake (make-array initial-size :initial-element initial-position))))
|
|
|
|
;;; Pretty-print a game
|
|
(defmethod print-object ((g game) stream)
|
|
(with-slots (snake dir) g
|
|
(format t "Snake: ")
|
|
(dotimes (i (first (array-dimensions snake)))
|
|
(let ((elem (aref snake i)))
|
|
(unless (eql i 0)
|
|
(format t "<="))
|
|
(format t "(~a,~a)" (first elem) (second elem))))
|
|
(format t "~%Size: ~a" (first (array-dimensions snake)))
|
|
(format t "~%Direction: ~a" dir)))
|
|
|
|
(defgeneric refresh (g &key)
|
|
(:documentation "Refresh the game g (move forward or change direction)."))
|
|
|
|
;;; 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)))))
|
|
|
|
(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 (first (array-dimensions snake)))
|
|
(let ((elem (aref snake i)))
|
|
(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)))
|
|
(format t "l:(~a,~a) n:(~a,~a) ~%" last-old-x last-old-y x y)
|
|
(setf (aref snake i) (list x y))))))) ; Apply new snake location (update snake slot)
|
|
|
|
;; Check if we loose
|
|
)
|