nandi/jolt-native · asteroids.clj

⑂ 2271a9188bb358e15c020f96d9923f906e495c56

asteroids.clj · 153 lines · 6.1 KBClojure    Blame HistoryRaw
Play three games on the gfx backend   1(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]))
14(def ^:private W 640)
15(def ^:private H 480)
16(def ^:private TURN 0.26)         ; radians per frame
17(def ^:private COOLDOWN 4)        ; frames between shots while space is held
18(def ^:private THRUST 0.18)
19(def ^:private DRAG 0.99)
20(def ^:private BULLET-SPEED 6.0)
21(def ^:private BULLET-LIFE 60)    ; frames
23;; keysyms, as XLookupKeysym reports them
24(def ^:private LEFT #{0xff51 0x61}) (def ^:private RIGHT #{0xff53 0x64})
25(def ^:private THRUSTK #{0xff52 0x77}) (def ^:private FIRE #{0x20})
27;; --- geometry ---------------------------------------------------------------
29(defn wrap [[x y]] [(mod x W) (mod y H)])
31(defn- rotate [[x y] a]
(let [c (Math/cos a) s (Math/sin a)] [(- (* x c) (* y s)) (+ (* x s) (* y c))]))
34(defn- at [pts pos angle scale]
(mapv (fn [p] (mapv + pos (rotate (mapv * p [scale scale]) angle))) pts))
37(defn- dist2 [[ax ay] [bx by]]
(let [dx (- ax bx) dy (- ay by)] (+ (* dx dx) (* dy dy))))
40
"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)]))))
47(def ^:private ship-shape [[1 0] [-0.6 0.6] [-0.3 0] [-0.6 -0.6]])
49(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)))
57(defn- rock [size]
{:pos [(rand W) (rand H)]
 :vel [(- (rand 2.4) 1.2) (- (rand 2.4) 1.2)]
 :size size :shape (rock-shape)})
62(defn- rock-radius [size] (* 14 size))
64;; --- one frame --------------------------------------------------------------
66(defn- drift [o] (update o :pos #(wrap (mapv + % (:vel o)))))
68(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)))
77(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))))
83(defn- collide
"Bullets against rocks: whatever each hit, gone; each rock hit, split."
[bullets rocks]
(let [struck (into {} (for [b bullets
                            :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)]))
94
"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?))))
117;; --- paint ------------------------------------------------------------------
119(def ^:private colours {:bg 0x0b0d12 :ship 0xffffff :flame 0xd08050
                      :rock 0x9aa0b0 :shot 0x5a6ea0 :fg 0xffffff})
122(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)))
137(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})
141(defn -main [& _]
(let [state (atom (new-game))]
  (w/run-window
    {:width W :height H :title "asteroids"}
    (fn [buf input]
      (draw! buf (swap! state
                          ;; 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))))))))))

Play three games on the gfx backend e98a184 nandi 11d ago	1	(ns glimmer-gfx.asteroids
	2	"Asteroids: vector art, which is the one kind of graphics a line routine and
	3	some trigonometry get you for free.
	4
	5	Every shape here is a list of points in model space, rotated and translated
	6	each frame and drawn with `raster/poly!`. Nothing is a sprite, nothing is a
	7	bitmap, and the whole world is a map of plain vectors -- so `step` is pure
	8	and the loop is a `swap!` on it.
	9
	10	Left/right or A/D turn, W or up thrusts, space fires."
	11	(:require [glimmer-gfx.raster :as r]
	12	[glimmer-gfx.x11 :as w]))
	13
	14	(def ^:private W 640)
	15	(def ^:private H 480)
	16	(def ^:private TURN 0.26) ; radians per frame
	17	(def ^:private COOLDOWN 4) ; frames between shots while space is held
	18	(def ^:private THRUST 0.18)
	19	(def ^:private DRAG 0.99)
	20	(def ^:private BULLET-SPEED 6.0)
	21	(def ^:private BULLET-LIFE 60) ; frames
	22
	23	;; keysyms, as XLookupKeysym reports them
	24	(def ^:private LEFT #{0xff51 0x61}) (def ^:private RIGHT #{0xff53 0x64})
	25	(def ^:private THRUSTK #{0xff52 0x77}) (def ^:private FIRE #{0x20})
	26
	27	;; --- geometry ---------------------------------------------------------------
	28
	29	(defn wrap [[x y]] [(mod x W) (mod y H)])
	30
	31	(defn- rotate [[x y] a]
	32	(let [c (Math/cos a) s (Math/sin a)] [(- (* x c) (* y s)) (+ (* x s) (* y c))]))
	33
	34	(defn- at [pts pos angle scale]
	35	(mapv (fn [p] (mapv + pos (rotate (mapv * p [scale scale]) angle))) pts))
	36
	37	(defn- dist2 [[ax ay] [bx by]]
	38	(let [dx (- ax bx) dy (- ay by)] (+ (* dx dx) (* dy dy))))
	39
	40	(defn hit?
	41	"Circle overlap, on a wrapped world: compare against the nearest image of b."
	42	[a b radius]
	43	(let [[bx by] b]
	44	(some #(< (dist2 a %) (* radius radius))
	45	(for [ox [(- W) 0 W] oy [(- H) 0 H]] [(+ bx ox) (+ by oy)]))))
	46
	47	(def ^:private ship-shape [[1 0] [-0.6 0.6] [-0.3 0] [-0.6 -0.6]])
	48
	49	(defn- rock-shape
	50	"A lumpy ring: eight points, each pushed out by a random amount."
	51	[]
	52	(mapv (fn [i] (let [a (* i (/ (* 2 Math/PI) 8))
	53	d (+ 0.7 (rand 0.5))]
	54	[(* d (Math/cos a)) (* d (Math/sin a))]))
	55	(range 8)))
	56
	57	(defn- rock [size]
	58	{:pos [(rand W) (rand H)]
	59	:vel [(- (rand 2.4) 1.2) (- (rand 2.4) 1.2)]
	60	:size size :shape (rock-shape)})
	61
	62	(defn- rock-radius [size] (* 14 size))
	63
	64	;; --- one frame --------------------------------------------------------------
65
66	(defn- drift [o] (update o :pos #(wrap (mapv + % (:vel o)))))
67
68	(defn- fly [ship keys]
69	(let [a (cond-> (:angle ship)
70	(some LEFT keys) (- TURN)
71	(some RIGHT keys) (+ TURN))
72	thrusting (boolean (some THRUSTK keys))
73	vel (cond-> (mapv #(* DRAG %) (:vel ship))
74	thrusting (->> (mapv + [(* THRUST (Math/cos a)) (* THRUST (Math/sin a))])))]
75	(assoc (drift (assoc ship :angle a :vel vel)) :thrusting thrusting)))
76
77	(defn- split
78	"A rock that was shot becomes two smaller ones, or nothing at size 1."
79	[{:keys [pos size]}]
80	(when (> size 1)
81	(repeatedly 2 #(assoc (rock (dec size)) :pos pos))))
82
83	(defn- collide
84	"Bullets against rocks: whatever each hit, gone; each rock hit, split."
85	[bullets rocks]
86	(let [struck (into {} (for [b bullets
87	rk rocks
88	:when (hit? (:pos b) (:pos rk) (rock-radius (:size rk)))]
89	[rk b]))]
90	[(remove (set (vals struck)) bullets)
91	(into (vec (remove struck rocks)) (mapcat split (keys struck)))
92	(count struck)]))
93
94	(defn step
95	"One frame. Pure: state and the keys held in, state out."
96	[{:keys [ship bullets rocks score fired?] :as st} keys]
97	(let [ship (fly ship keys)
98	firing? (boolean (some FIRE keys))
99	;; hold to auto-fire, but not every frame: COOLDOWN paces it
100	cool (if firing? (dec (or (:cool st) 0)) 0)
101	shoot? (and firing? (not (pos? cool)))
102	bullets (cond->> (->> bullets
103	(map #(update (drift %) :life dec))
104	(filter #(pos? (:life %))))
105	shoot?
106	(cons {:pos (:pos ship) :life BULLET-LIFE
107	:vel [(* BULLET-SPEED (Math/cos (:angle ship)))
108	(* BULLET-SPEED (Math/sin (:angle ship)))]}))
109	[bullets rocks n] (collide bullets (map drift rocks))
110	dead? (some #(hit? (:pos ship) (:pos %) (rock-radius (:size %))) rocks)]
111	(assoc st :ship ship :bullets (vec bullets) :fired? firing?
112	:cool (if shoot? COOLDOWN cool)
113	:rocks (if (seq rocks) (vec rocks) (vec (repeatedly 5 #(rock 3))))
114	:score (+ score (* 10 n))
115	:lost? (boolean dead?))))
116
117	;; --- paint ------------------------------------------------------------------
118
119	(def ^:private colours {:bg 0x0b0d12 :ship 0xffffff :flame 0xd08050
120	:rock 0x9aa0b0 :shot 0x5a6ea0 :fg 0xffffff})
121
122	(defn- draw! [buf {:keys [ship bullets rocks score lost?]}]
123	(r/clear buf (:bg colours))
124	(doseq [rk rocks]
125	(r/poly! buf (at (:shape rk) (:pos rk) 0 (rock-radius (:size rk))) (:rock colours)))
126	(doseq [b bullets]
127	(let [[x y] (:pos b)] (r/rect! buf (int x) (int y) 2 2 (:shot colours))))
128	(when-not lost?
129	(r/poly! buf (at ship-shape (:pos ship) (:angle ship) 10) (:ship colours))
130	(when (:thrusting ship)
131	(r/poly! buf (at [[-0.6 0.35] [-1.3 0] [-0.6 -0.35]] (:pos ship) (:angle ship) 10)
132	(:flame colours))))
133	(r/text! buf 8 8 (str "SCORE " score) (:fg colours) 2)
134	(when lost?
135	(r/text! buf (- (quot W 2) 60) (quot H 2) "GAME OVER" (:fg colours) 3)))
136
137	(defn new-game []
138	{:ship {:pos [(/ W 2.0) (/ H 2.0)] :vel [0 0] :angle 0}
139	:bullets [] :rocks (vec (repeatedly 5 #(rock 3))) :score 0 :fired? false :cool 0})
140
141	(defn -main [& _]
142	(let [state (atom (new-game))]
143	(w/run-window
144	{:width W :height H :title "asteroids"}
145	(fn [buf input]
146	(draw! buf (swap! state
147	(fn [st]
148	;; dead: space starts a new game rather than firing
149	(if (:lost? st)
150	(if (and (some FIRE (:keys input)) (not (:fired? st)))
151	(new-game)
152	(assoc st :fired? (boolean (some FIRE (:keys input)))))
153	(step st (:keys input))))))))))