blob: 5c0e3681531d2be7ebd3602c66d514620307f12f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(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))))
;;; 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)."))
;;; 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))
(new-snake (coerce (make-array new-size :initial-contents `(,@snake ,@new-tail)) 'list)))
new-snake))
(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)))
(format t "l:(~a,~a) n:(~a,~a) ~%" last-old-x last-old-y x y)
(setf (nth i snake) (list x y))))))) ; Apply new snake location (update snake slot)
;; Check if we loose
)
;;; 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))))
(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 (coerce (make-array (1+ (length food)) :initial-contents `(,@food ,(list x y))) 'list))))))))
|
