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
|
(ns glimmer-gfx.asteroids
"Asteroids: vector art, which is the one kind of graphics a line routine and
some trigonometry get you for free.
Every shape here is a list of points in model space, rotated and translated
each frame and drawn with `raster/poly!`. Nothing is a sprite, nothing is a
bitmap, and the whole world is a map of plain vectors -- so `step` is pure
and the loop is a `swap!` on it.
Left/right or A/D turn, W or up thrusts, space fires."
(:require [glimmer-gfx.raster :as r]
[glimmer-gfx.x11 :as w]))
(def ^:private W 640)
(def ^:private H 480)
(def ^:private TURN 0.26) ; radians per frame
(def ^:private COOLDOWN 4) ; frames between shots while space is held
(def ^:private THRUST 0.18)
(def ^:private DRAG 0.99)
(def ^:private BULLET-SPEED 6.0)
(def ^:private BULLET-LIFE 60) ; frames
;; keysyms, as XLookupKeysym reports them
(def ^:private LEFT #{0xff51 0x61}) (def ^:private RIGHT #{0xff53 0x64})
(def ^:private THRUSTK #{0xff52 0x77}) (def ^:private FIRE #{0x20})
;; --- geometry ---------------------------------------------------------------
(defn wrap [[x y]] [(mod x W) (mod y H)])
(defn- rotate [[x y] a]
(let [c (Math/cos a) s (Math/sin a)] [(- (* x c) (* y s)) (+ (* x s) (* y c))]))
(defn- at [pts pos angle scale]
(mapv (fn [p] (mapv + pos (rotate (mapv * p [scale scale]) angle))) pts))
(defn- dist2 [[ax ay] [bx by]]
(let [dx (- ax bx) dy (- ay by)] (+ (* dx dx) (* dy dy))))
(defn hit?
"Circle overlap, on a wrapped world: compare against the nearest image of b."
[a b radius]
(let [[bx by] b]
(some #(< (dist2 a %) (* radius radius))
(for [ox [(- W) 0 W] oy [(- H) 0 H]] [(+ bx ox) (+ by oy)]))))
(def ^:private ship-shape [[1 0] [-0.6 0.6] [-0.3 0] [-0.6 -0.6]])
(defn- rock-shape
"A lumpy ring: eight points, each pushed out by a random amount."
[]
(mapv (fn [i] (let [a (* i (/ (* 2 Math/PI) 8))
d (+ 0.7 (rand 0.5))]
[(* d (Math/cos a)) (* d (Math/sin a))]))
(range 8)))
(defn- rock [size]
{:pos [(rand W) (rand H)]
:vel [(- (rand 2.4) 1.2) (- (rand 2.4) 1.2)]
:size size :shape (rock-shape)})
(defn- rock-radius [size] (* 14 size))
;; --- one frame --------------------------------------------------------------
(defn- drift [o] (update o :pos #(wrap (mapv + % (:vel o)))))
(defn- fly [ship keys]
(let [a (cond-> (:angle ship)
(some LEFT keys) (- TURN)
(some RIGHT keys) (+ TURN))
thrusting (boolean (some THRUSTK keys))
vel (cond-> (mapv #(* DRAG %) (:vel ship))
thrusting (->> (mapv + [(* THRUST (Math/cos a)) (* THRUST (Math/sin a))])))]
(assoc (drift (assoc ship :angle a :vel vel)) :thrusting thrusting)))
(defn- split
"A rock that was shot becomes two smaller ones, or nothing at size 1."
[{:keys [pos size]}]
(when (> size 1)
(repeatedly 2 #(assoc (rock (dec size)) :pos pos))))
(defn- collide
"Bullets against rocks: whatever each hit, gone; each rock hit, split."
[bullets rocks]
(let [struck (into {} (for [b bullets
rk rocks
:when (hit? (:pos b) (:pos rk) (rock-radius (:size rk)))]
[rk b]))]
[(remove (set (vals struck)) bullets)
(into (vec (remove struck rocks)) (mapcat split (keys struck)))
(count struck)]))
(defn step
"One frame. Pure: state and the keys held in, state out."
[{:keys [ship bullets rocks score fired?] :as st} keys]
(let [ship (fly ship keys)
firing? (boolean (some FIRE keys))
;; hold to auto-fire, but not every frame: COOLDOWN paces it
cool (if firing? (dec (or (:cool st) 0)) 0)
shoot? (and firing? (not (pos? cool)))
bullets (cond->> (->> bullets
(map #(update (drift %) :life dec))
(filter #(pos? (:life %))))
shoot?
(cons {:pos (:pos ship) :life BULLET-LIFE
:vel [(* BULLET-SPEED (Math/cos (:angle ship)))
(* BULLET-SPEED (Math/sin (:angle ship)))]}))
[bullets rocks n] (collide bullets (map drift rocks))
dead? (some #(hit? (:pos ship) (:pos %) (rock-radius (:size %))) rocks)]
(assoc st :ship ship :bullets (vec bullets) :fired? firing?
:cool (if shoot? COOLDOWN cool)
:rocks (if (seq rocks) (vec rocks) (vec (repeatedly 5 #(rock 3))))
:score (+ score (* 10 n))
:lost? (boolean dead?))))
;; --- paint ------------------------------------------------------------------
(def ^:private colours {:bg 0x0b0d12 :ship 0xffffff :flame 0xd08050
:rock 0x9aa0b0 :shot 0x5a6ea0 :fg 0xffffff})
(defn- draw! [buf {:keys [ship bullets rocks score lost?]}]
(r/clear buf (:bg colours))
(doseq [rk rocks]
(r/poly! buf (at (:shape rk) (:pos rk) 0 (rock-radius (:size rk))) (:rock colours)))
(doseq [b bullets]
(let [[x y] (:pos b)] (r/rect! buf (int x) (int y) 2 2 (:shot colours))))
(when-not lost?
(r/poly! buf (at ship-shape (:pos ship) (:angle ship) 10) (:ship colours))
(when (:thrusting ship)
(r/poly! buf (at [[-0.6 0.35] [-1.3 0] [-0.6 -0.35]] (:pos ship) (:angle ship) 10)
(:flame colours))))
(r/text! buf 8 8 (str "SCORE " score) (:fg colours) 2)
(when lost?
(r/text! buf (- (quot W 2) 60) (quot H 2) "GAME OVER" (:fg colours) 3)))
(defn new-game []
{:ship {:pos [(/ W 2.0) (/ H 2.0)] :vel [0 0] :angle 0}
:bullets [] :rocks (vec (repeatedly 5 #(rock 3))) :score 0 :fired? false :cool 0})
(defn -main [& _]
(let [state (atom (new-game))]
(w/run-window
{:width W :height H :title "asteroids"}
(fn [buf input]
(draw! buf (swap! state
(fn [st]
;; dead: space starts a new game rather than firing
(if (:lost? st)
(if (and (some FIRE (:keys input)) (not (:fired? st)))
(new-game)
(assoc st :fired? (boolean (some FIRE (:keys input)))))
(step st (:keys input))))))))))
|