forked from mvolkmann/mvolkmann.github.com
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathClojureSnake.html
More file actions
288 lines (250 loc) · 9.11 KB
/
Copy pathClojureSnake.html
File metadata and controls
288 lines (250 loc) · 9.11 KB
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR.html1/DTD.html1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Clojure Snake Game</title>
<link rel="stylesheet" type="text/css" href="../common.css"/>
</head>
<body>
<h2>Clojure Snake Game</h2>
<p>
This is the Clojure source code, written in an intentional style,
for a simple game. It was originally written by Abhishek Reddy.
It is being presented as an example of good Clojure coding style.
Feedback is welcomed at
<a href="mailto:r.mark.volkmann@gmail.com">r.mark.volkmann@gmail.com</a>.
</p>
<p>
To run this, save the code in a file named "snake.clj"
and run "clj snake.clj". Of course this assumes you've
creates the clj script for running Clojure code or a REPL.
</p>
<div class="code"><pre>
; This is a Swing-based game where the arrow keys to guide
; a snake to apples. Each time the snake eats an apple it
; grows and a new apple appears in a random location.
; If the head of the snake hits its body, you lose.
; If the snake grows to a length of 10, you win.
; In either case the game starts over with a new, baby snake.
;
; This was originally written by Abhishek Reddy.
; Mark Volkmann rewrote it in an attempt to make it easier to understand.
(ns com.ociweb.snake
(:import
(java.awt Color Dimension)
(java.awt.event KeyListener)
(javax.swing JFrame JOptionPane JPanel))
(:use clojure.contrib.import-static))
(import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)
(defstruct cell-struct :x :y)
(defstruct snake-struct :body :direction)
(defstruct game-struct
:panel :cell-size :length-to-win :ms-per-move :apple :snake)
(defn board-dimensions [panel cell-size]
(let [size (.getPreferredSize panel)]
[(quot (.getWidth size) cell-size)
(quot (.getHeight size) cell-size)]))
(defn create-center-cell [width height]
(struct cell-struct (quot width 2) (quot height 2)))
(defn create-random-cell [width height]
(struct cell-struct (rand-int (- width 1)) (rand-int (- height 1))))
(defn create-snake [width height]
(let [head (create-center-cell width height)
body (list head)]
(struct snake-struct body :right)))
(defn create-game [panel cell-size]
(let [length-to-win 10
ms-per-move 50
[width height] (board-dimensions panel cell-size)
apple (create-random-cell width height)
snake (create-snake width height)]
(struct game-struct
panel cell-size length-to-win ms-per-move apple snake)))
(defn paint-cell [panel color cell-size {x :x y :y}]
(let [graphics (.getGraphics panel)]
(.setColor graphics color)
(.fillRect graphics
(* x cell-size) (* y cell-size) cell-size cell-size)))
(defn erase-cell [game cell]
(let [panel (game :panel)
color (.getBackground panel)
cell-size (game :cell-size)]
(paint-cell panel color cell-size cell)))
(defn erase-apple [game]
(let [apple (game :apple)]
(erase-cell game apple)))
(defn erase-snake [game]
(doseq [cell ((game :snake) :body)]
(erase-cell game cell)))
(defn paint-apple [panel cell-size apple]
(paint-cell panel Color/RED cell-size apple))
(defn paint-snake [panel cell-size snake]
; We only need to paint the head because
; the rest will have been already painted.
(let [head (first (snake :body))]
(paint-cell panel Color/GREEN cell-size head)))
(defn paint-game [game]
(let [panel (game :panel)
cell-size (game :cell-size)]
(paint-apple panel cell-size (game :apple))
(paint-snake panel cell-size (game :snake))))
(defn new-apple [game]
(let [panel (game :panel)
cell-size (game :cell-size)
[width height] (board-dimensions panel cell-size)]
(erase-apple game)
(create-random-cell width height)))
(defn delta
"Gets a vector containing dx and dy values for a given direction."
[direction]
(direction {:left [-1 0], :right [1 0], :up [0 -1], :down [0 1]}))
(defn new-direction
"Returns the snake's direction, either the current direction
or a new one if a board edge was reached."
[game]
(let [snake (game :snake)
direction (snake :direction)
head (first (snake :body))
x (head :x)
y (head :y)
panel (game :panel)
cell-size (game :cell-size)
[width height] (board-dimensions panel cell-size)
at-left (= x 0)
at-right (= x (- width 1))
at-top (= y 0)
at-bottom (= y (- height 1))]
; Turn clockwise when a board edge is reached
; unless that would result in going off the board.
(cond
(and (= direction :up) at-top) (if at-right :left :right)
(and (= direction :right) at-right) (if at-bottom :up :down)
(and (= direction :down) at-bottom) (if at-left :right :left)
(and (= direction :left) at-left) (if at-top :down :up)
true direction)))
(defn same-or-adjacent-cell? [cell1 cell2]
(let [dx (Math/abs (- (cell1 :x) (cell2 :x)))
dy (Math/abs (- (cell1 :y) (cell2 :y)))]
(and (<= dx 1) (<= dy 1))))
(defn eat-apple? [game]
(let [apple (game :apple)
snake (game :snake)
head (first (snake :body))]
(same-or-adjacent-cell? head apple)))
(defn remove-tail [game body]
(let [tail (last body)]
(erase-cell game tail)
(butlast body)))
(defn move-snake [game grow]
"Moves the snake and returns a new snake-struct.
The snake grows it by one cell if 'grow' is true."
(let [direction (new-direction game)
[dx dy] (delta direction)
snake (game :snake)
body (snake :body)
head (first body)
x (head :x)
y (head :y)
new-head (struct cell-struct (+ x dx) (+ y dy))
body (cons new-head body)
body (if grow body (remove-tail game body))]
(struct snake-struct body direction)))
(defn get-key-direction
"Gets a keyword that describes the direction
associated with a given key code."
[key-code]
(cond
(= key-code VK_LEFT) :left
(= key-code VK_RIGHT) :right
(= key-code VK_UP) :up
(= key-code VK_DOWN) :down
true nil))
(defn snake-with-key-direction [snake key-code-atom]
(let [key-code @key-code-atom
key-direction (get-key-direction key-code)
current (snake :direction)
; Don't let the snake double back on itself.
valid-change (cond
(= key-direction nil) false
(= key-direction :left) (not= current :right)
(= key-direction :right) (not= current :left)
(= key-direction :up) (not= current :down)
(= key-direction :down) (not= current :up)
true true)]
(if valid-change
(do
(compare-and-set! key-code-atom key-code nil)
(assoc snake :direction key-direction))
snake)))
(defn head-overlaps-body? [body]
(let [head (first body)]
(some #(= % head) (rest body))))
(defn restart-game [game]
(erase-apple game)
(erase-snake game)
(create-game (game :panel) (game :cell-size)))
(defn new-game [game message]
(let [panel (game :panel)
top (.getTopLevelAncestor panel)]
(JOptionPane/showMessageDialog top message)
(restart-game game)))
(defn win? [game]
(let [snake (game :snake)
body (snake :body)]
(= (count body) (game :length-to-win))))
(defn lose? [game]
(let [snake (game :snake)
body (snake :body)]
(head-overlaps-body? body)))
(defn step [game key-code-atom]
(let [eat (eat-apple? game)
snake (snake-with-key-direction (game :snake) key-code-atom)
game (assoc game :snake snake)
game (if eat (assoc game :apple (new-apple game)) game)
snake (move-snake game eat)]
(cond
(lose? game) (new-game game "You killed the snake!")
(win? game) (new-game game "You win!")
true (assoc game :snake snake))))
(defn create-panel [width height key-code-atom]
(proxy [JPanel KeyListener]
[] ; superclass constructor arguments
(getPreferredSize [] (Dimension. width height))
(keyPressed [e]
(compare-and-set! key-code-atom @key-code-atom (.getKeyCode e)))
(keyReleased [e]) ; do nothing
(keyTyped [e]) ; do nothing
))
(defn configure-gui [frame panel]
(doto panel
(.setFocusable true) ; won't generate key events without this
(.addKeyListener panel))
(doto frame
(.add panel)
(.pack)
(.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
(.setVisible true)))
(defn main []
(let [frame (JFrame. "Snake")
width 30
height 30
cell-size 10
key-code-atom (atom nil)
panel-width (* width cell-size)
panel-height (* height cell-size)
panel (create-panel panel-width panel-height key-code-atom)
first-game (create-game panel cell-size)]
(configure-gui frame panel)
(loop [game first-game]
(paint-game game)
(Thread/sleep (game :ms-per-move))
(recur (step game key-code-atom)))))
; Only run the application if this is being run as a script,
; not if loaded in a REPL with load-file.
; When run as a script, the path to this file
; will be a command-line argument.
(if *command-line-args* (main))
</pre></div>
</body>
</html>