rickub
Sign in Get started
nandi/jolt-nativepublic⑂ Fork 0
⑂ e98a184
Branches
main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Play three games on the gfx backend

tictactoe is the widget set doing something other than a settings panel: a
grid of buttons and one pure rule, through the reconciler like any other
component.

maze and asteroids are the layer below. Sixty frames a second whatever the
user does, so there is nothing for a reconciler to reconcile -- they take
run-window and the rasterizer directly. That needed two things the backend
did not have:

  * keys. x11 now reports the keysyms held this frame, via XLookupKeysym so
    the layout decides what a key means, and XkbSetDetectableAutoRepeat so a
    held key does not flicker as repeat sends release/press pairs.
  * poly!. Four lines in raster, and the whole of vector art: asteroids has
    no sprite and no bitmap, just points rotated per frame.

Every rule is pure and every check is headless, so the tests play a game --
firing, splitting, scoring, dying across the wrap seam -- with no display.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-07T18:57:27-07:00 Browse files
e98a184 parent: b6001e6
modified deps.edn +4 -1
@@ -6,4 +6,7 @@
66 ;; /usr/lib libX11 — different glibc, fails before dlopen returns. The #gfx
77 ;; shell is that one library on LD_LIBRARY_PATH and nothing else, so entering
88 ;; it costs under a second once its env derivation is built.
9-{:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"}}
9+{:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"
10+ gfx-game "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt tictactoe'"
11+ gfx-maze "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt maze'"
12+ gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"}}
@@ -6,4 +6,7 @@
6 ;; /usr/lib libX11 — different glibc, fails before dlopen returns. The #gfx6 ;; /usr/lib libX11 — different glibc, fails before dlopen returns. The #gfx
7 ;; shell is that one library on LD_LIBRARY_PATH and nothing else, so entering7 ;; shell is that one library on LD_LIBRARY_PATH and nothing else, so entering
8 ;; it costs under a second once its env derivation is built.8 ;; it costs under a second once its env derivation is built.
9-{:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"}}9+{:tasks {gfx-demo "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt counter'"
10+ gfx-game "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt tictactoe'"
11+ gfx-maze "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt maze'"
12+ gfx-rocks "nix develop .#gfx -c bash -c 'cd glimmer-backends/glimmer-gfx && jolt asteroids'"}}
modified glimmer-backends/glimmer-gfx/README.md +14 -0
@@ -29,12 +29,26 @@ here, a pixel at a time, by code in this directory:
2929 ```bash
3030 jolt test # headless: no window, no display
3131 LD_LIBRARY_PATH=/path/to/libX11 jolt counter
32+LD_LIBRARY_PATH=/path/to/libX11 jolt tictactoe # a game, in the same widgets
33+LD_LIBRARY_PATH=/path/to/libX11 jolt maze # WASD, under the widgets
34+LD_LIBRARY_PATH=/path/to/libX11 jolt asteroids # vector primitives, same two files
3235 ```
3336
3437 Xlib is a *system* library here, not one of this repo's crates, and it must be
3538 one the jolt binary can load — on a nix-built jolt, the host `/usr/lib` copy is
3639 a different glibc and fails before `dlopen` returns.
3740
41+`maze` is the other half of the story: sixty frames a second whatever you do,
42+so there is nothing for a reconciler to reconcile. It skips glimmer and talks
43+to `raster` and `x11` directly — `run-window` hands it a framebuffer and the
44+keys held this frame, which is all a game loop ever wanted.
45+
46+`asteroids` is what those primitives are actually for: every shape is a list of
47+points rotated and translated per frame and stroked with `raster/poly!`, so
48+there is no sprite, no bitmap and no asset — the ship is four points and some
49+trigonometry. `step` is pure, which is why the tests play a whole game without
50+a display.
51+
3852 ## What a backend has to do
3953
4054 Read this one first. It is the smallest complete backend in the repo, and the
@@ -29,12 +29,26 @@ here, a pixel at a time, by code in this directory:
29 ```bash29 ```bash
30 jolt test # headless: no window, no display30 jolt test # headless: no window, no display
31 LD_LIBRARY_PATH=/path/to/libX11 jolt counter31 LD_LIBRARY_PATH=/path/to/libX11 jolt counter
32+LD_LIBRARY_PATH=/path/to/libX11 jolt tictactoe # a game, in the same widgets
33+LD_LIBRARY_PATH=/path/to/libX11 jolt maze # WASD, under the widgets
34+LD_LIBRARY_PATH=/path/to/libX11 jolt asteroids # vector primitives, same two files
32 ```35 ```
33 36
34 Xlib is a *system* library here, not one of this repo's crates, and it must be37 Xlib is a *system* library here, not one of this repo's crates, and it must be
35 one the jolt binary can load — on a nix-built jolt, the host `/usr/lib` copy is38 one the jolt binary can load — on a nix-built jolt, the host `/usr/lib` copy is
36 a different glibc and fails before `dlopen` returns.39 a different glibc and fails before `dlopen` returns.
37 40
41+`maze` is the other half of the story: sixty frames a second whatever you do,
42+so there is nothing for a reconciler to reconcile. It skips glimmer and talks
43+to `raster` and `x11` directly — `run-window` hands it a framebuffer and the
44+keys held this frame, which is all a game loop ever wanted.
45+
46+`asteroids` is what those primitives are actually for: every shape is a list of
47+points rotated and translated per frame and stroked with `raster/poly!`, so
48+there is no sprite, no bitmap and no asset — the ship is four points and some
49+trigonometry. `step` is pure, which is why the tests play a whole game without
50+a display.
51+
38 ## What a backend has to do52 ## What a backend has to do
39 53
40 Read this one first. It is the smallest complete backend in the repo, and the54 Read this one first. It is the smallest complete backend in the repo, and the
modified glimmer-backends/glimmer-gfx/deps.edn +13 -4
@@ -19,10 +19,19 @@
1919 :jolt/native [{:name "X11" :optional true
2020 :linux ["libX11.so.6"] :darwin ["libX11.6.dylib"]}]
2121
22- :aliases {:counter {:extra-paths ["examples"]
22+ :aliases {:tictactoe {:extra-paths ["examples"]
23+ :main-opts ["-m" "glimmer-gfx.tictactoe"]}
24+ :maze {:extra-paths ["examples"]
25+ :main-opts ["-m" "glimmer-gfx.maze"]}
26+ :asteroids {:extra-paths ["examples"]
27+ :main-opts ["-m" "glimmer-gfx.asteroids"]}
28+ :counter {:extra-paths ["examples"]
2329 :main-opts ["-m" "glimmer-gfx.counter"]}
24- :test {:extra-paths ["test"]
30+ :test {:extra-paths ["test" "examples"]
2531 :main-opts ["-m" "glimmer-gfx.tests"]}}
2632
27- :tasks {counter "jolt -M:counter"
28- test "jolt -M:test"}}
33+ :tasks {counter "jolt -M:counter"
34+ tictactoe "jolt -M:tictactoe"
35+ maze "jolt -M:maze"
36+ asteroids "jolt -M:asteroids"
37+ test "jolt -M:test"}}
@@ -19,10 +19,19 @@
19 :jolt/native [{:name "X11" :optional true19 :jolt/native [{:name "X11" :optional true
20 :linux ["libX11.so.6"] :darwin ["libX11.6.dylib"]}]20 :linux ["libX11.so.6"] :darwin ["libX11.6.dylib"]}]
21 21
22- :aliases {:counter {:extra-paths ["examples"]22+ :aliases {:tictactoe {:extra-paths ["examples"]
23+ :main-opts ["-m" "glimmer-gfx.tictactoe"]}
24+ :maze {:extra-paths ["examples"]
25+ :main-opts ["-m" "glimmer-gfx.maze"]}
26+ :asteroids {:extra-paths ["examples"]
27+ :main-opts ["-m" "glimmer-gfx.asteroids"]}
28+ :counter {:extra-paths ["examples"]
23 :main-opts ["-m" "glimmer-gfx.counter"]}29 :main-opts ["-m" "glimmer-gfx.counter"]}
24- :test {:extra-paths ["test"]30+ :test {:extra-paths ["test" "examples"]
25 :main-opts ["-m" "glimmer-gfx.tests"]}}31 :main-opts ["-m" "glimmer-gfx.tests"]}}
26 32
27- :tasks {counter "jolt -M:counter"33+ :tasks {counter "jolt -M:counter"
28- test "jolt -M:test"}}34+ tictactoe "jolt -M:tictactoe"
35+ maze "jolt -M:maze"
36+ asteroids "jolt -M:asteroids"
37+ test "jolt -M:test"}}
added glimmer-backends/glimmer-gfx/examples/glimmer_gfx/asteroids.clj +153 -0
new file mode 100644
@@ -0,0 +1,153 @@
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))))))))))
new file mode 100644
@@ -0,0 +1,153 @@
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))))))))))
added glimmer-backends/glimmer-gfx/examples/glimmer_gfx/maze.clj +100 -0
new file mode 100644
@@ -0,0 +1,100 @@
1+(ns glimmer-gfx.maze
2+ "A WASD game on the same two files the widgets use, and nothing else.
3+
4+ There is no glimmer here: a reconciler is for a UI that changes when state
5+ changes, and this changes sixty times a second whatever you do. So it takes
6+ the layer below -- x11 gives a framebuffer and the keys held this frame,
7+ raster draws into it -- which is the whole of what a game loop needs.
8+
9+ Walk over the dots, don't walk through walls."
10+ (:require [glimmer-gfx.raster :as r]
11+ [glimmer-gfx.x11 :as w]))
12+
13+(def ^:private CELL 24)
14+(def ^:private SPEED 3) ; pixels per frame
15+
16+;; keysyms, as XLookupKeysym reports them
17+(def ^:private keymap
18+ {0x77 [0 -1] 0x73 [0 1] 0x61 [-1 0] 0x64 [1 0] ; w s a d
19+ 0xff52 [0 -1] 0xff54 [0 1] 0xff51 [-1 0] 0xff53 [1 0]}) ; arrows
20+
21+(def ^:private level
22+ ["###################"
23+ "#....#........#...#"
24+ "#.##.#.######.#.#.#"
25+ "#.#..........#..#.#"
26+ "#.#.####.###.####.#"
27+ "#...#......#......#"
28+ "#.###.####.#.####.#"
29+ "#.....#......#....#"
30+ "###################"])
31+
32+(defn wall? [level c r]
33+ (let [row (get level r)]
34+ (or (nil? row) (not= \. (get row c \#)))))
35+
36+(defn- cells-under
37+ "The grid cells a CELL-sized box at (x,y) overlaps."
38+ [x y]
39+ (for [c [(quot x CELL) (quot (+ x CELL -1) CELL)]
40+ r [(quot y CELL) (quot (+ y CELL -1) CELL)]]
41+ [c r]))
42+
43+(defn free?
44+ "May the player box sit at (x,y)?"
45+ [level x y]
46+ (and (>= x 0) (>= y 0)
47+ (every? (fn [[c r]] (not (wall? level c r))) (cells-under x y))))
48+
49+(defn move
50+ "Slide along a wall rather than stopping dead: each axis is tried alone."
51+ [level [x y] [dx dy]]
52+ (let [x' (if (free? level (+ x (* dx SPEED)) y) (+ x (* dx SPEED)) x)
53+ y' (if (free? level x' (+ y (* dy SPEED))) (+ y (* dy SPEED)) y)]
54+ [x' y']))
55+
56+(defn- dir [keys]
57+ (let [[dx dy] (reduce (fn [a b] (mapv + a b)) [0 0]
58+ (keep keymap keys))]
59+ [(min 1 (max -1 dx)) (min 1 (max -1 dy))]))
60+
61+(defn- dots [level]
62+ (set (for [r (range (count level)) c (range (count (level r)))
63+ :when (= \. (get (level r) c))
64+ :when (odd? (+ c r))] ; every other cell
65+ [c r])))
66+
67+(defn eat
68+ "The dot the player's centre is standing on, removed."
69+ [dots [x y]]
70+ (disj dots [(quot (+ x (quot CELL 2)) CELL) (quot (+ y (quot CELL 2)) CELL)]))
71+
72+(def ^:private colours
73+ {:bg 0x1c1e26 :wall 0x373b49 :dot 0x9aa0b0 :player 0x5a6ea0 :fg 0xffffff})
74+
75+(defn- draw! [buf {:keys [pos dots]}]
76+ (r/clear buf (:bg colours))
77+ (dotimes [r (count level)]
78+ (dotimes [c (count (level r))]
79+ (when (wall? level c r)
80+ (r/rect! buf (* c CELL) (* r CELL) (dec CELL) (dec CELL) (:wall colours)))))
81+ (doseq [[c r] dots]
82+ (r/rect! buf (+ 9 (* c CELL)) (+ 9 (* r CELL)) 6 6 (:dot colours)))
83+ (let [[x y] pos]
84+ (r/rect! buf (inc x) (inc y) (- CELL 2) (- CELL 2) (:player colours)))
85+ (let [y (* CELL (count level))]
86+ (r/text! buf 8 (+ y 8)
87+ (if (empty? dots) "CLEARED" (str "DOTS LEFT: " (count dots)))
88+ (:fg colours) 2)))
89+
90+(defn -main [& _]
91+ (let [state (atom {:pos [CELL CELL] :dots (dots level)})]
92+ (w/run-window
93+ {:width (* CELL (count (first level)))
94+ :height (+ 32 (* CELL (count level)))
95+ :title "maze"}
96+ (fn [buf input]
97+ (draw! buf (swap! state
98+ (fn [{:keys [pos dots]}]
99+ (let [pos (move level pos (dir (:keys input)))]
100+ {:pos pos :dots (eat dots pos)}))))))))
new file mode 100644
@@ -0,0 +1,100 @@
1+(ns glimmer-gfx.maze
2+ "A WASD game on the same two files the widgets use, and nothing else.
3+
4+ There is no glimmer here: a reconciler is for a UI that changes when state
5+ changes, and this changes sixty times a second whatever you do. So it takes
6+ the layer below -- x11 gives a framebuffer and the keys held this frame,
7+ raster draws into it -- which is the whole of what a game loop needs.
8+
9+ Walk over the dots, don't walk through walls."
10+ (:require [glimmer-gfx.raster :as r]
11+ [glimmer-gfx.x11 :as w]))
12+
13+(def ^:private CELL 24)
14+(def ^:private SPEED 3) ; pixels per frame
15+
16+;; keysyms, as XLookupKeysym reports them
17+(def ^:private keymap
18+ {0x77 [0 -1] 0x73 [0 1] 0x61 [-1 0] 0x64 [1 0] ; w s a d
19+ 0xff52 [0 -1] 0xff54 [0 1] 0xff51 [-1 0] 0xff53 [1 0]}) ; arrows
20+
21+(def ^:private level
22+ ["###################"
23+ "#....#........#...#"
24+ "#.##.#.######.#.#.#"
25+ "#.#..........#..#.#"
26+ "#.#.####.###.####.#"
27+ "#...#......#......#"
28+ "#.###.####.#.####.#"
29+ "#.....#......#....#"
30+ "###################"])
31+
32+(defn wall? [level c r]
33+ (let [row (get level r)]
34+ (or (nil? row) (not= \. (get row c \#)))))
35+
36+(defn- cells-under
37+ "The grid cells a CELL-sized box at (x,y) overlaps."
38+ [x y]
39+ (for [c [(quot x CELL) (quot (+ x CELL -1) CELL)]
40+ r [(quot y CELL) (quot (+ y CELL -1) CELL)]]
41+ [c r]))
42+
43+(defn free?
44+ "May the player box sit at (x,y)?"
45+ [level x y]
46+ (and (>= x 0) (>= y 0)
47+ (every? (fn [[c r]] (not (wall? level c r))) (cells-under x y))))
48+
49+(defn move
50+ "Slide along a wall rather than stopping dead: each axis is tried alone."
51+ [level [x y] [dx dy]]
52+ (let [x' (if (free? level (+ x (* dx SPEED)) y) (+ x (* dx SPEED)) x)
53+ y' (if (free? level x' (+ y (* dy SPEED))) (+ y (* dy SPEED)) y)]
54+ [x' y']))
55+
56+(defn- dir [keys]
57+ (let [[dx dy] (reduce (fn [a b] (mapv + a b)) [0 0]
58+ (keep keymap keys))]
59+ [(min 1 (max -1 dx)) (min 1 (max -1 dy))]))
60+
61+(defn- dots [level]
62+ (set (for [r (range (count level)) c (range (count (level r)))
63+ :when (= \. (get (level r) c))
64+ :when (odd? (+ c r))] ; every other cell
65+ [c r])))
66+
67+(defn eat
68+ "The dot the player's centre is standing on, removed."
69+ [dots [x y]]
70+ (disj dots [(quot (+ x (quot CELL 2)) CELL) (quot (+ y (quot CELL 2)) CELL)]))
71+
72+(def ^:private colours
73+ {:bg 0x1c1e26 :wall 0x373b49 :dot 0x9aa0b0 :player 0x5a6ea0 :fg 0xffffff})
74+
75+(defn- draw! [buf {:keys [pos dots]}]
76+ (r/clear buf (:bg colours))
77+ (dotimes [r (count level)]
78+ (dotimes [c (count (level r))]
79+ (when (wall? level c r)
80+ (r/rect! buf (* c CELL) (* r CELL) (dec CELL) (dec CELL) (:wall colours)))))
81+ (doseq [[c r] dots]
82+ (r/rect! buf (+ 9 (* c CELL)) (+ 9 (* r CELL)) 6 6 (:dot colours)))
83+ (let [[x y] pos]
84+ (r/rect! buf (inc x) (inc y) (- CELL 2) (- CELL 2) (:player colours)))
85+ (let [y (* CELL (count level))]
86+ (r/text! buf 8 (+ y 8)
87+ (if (empty? dots) "CLEARED" (str "DOTS LEFT: " (count dots)))
88+ (:fg colours) 2)))
89+
90+(defn -main [& _]
91+ (let [state (atom {:pos [CELL CELL] :dots (dots level)})]
92+ (w/run-window
93+ {:width (* CELL (count (first level)))
94+ :height (+ 32 (* CELL (count level)))
95+ :title "maze"}
96+ (fn [buf input]
97+ (draw! buf (swap! state
98+ (fn [{:keys [pos dots]}]
99+ (let [pos (move level pos (dir (:keys input)))]
100+ {:pos pos :dots (eat dots pos)}))))))))
added glimmer-backends/glimmer-gfx/examples/glimmer_gfx/tictactoe.clj +60 -0
new file mode 100644
@@ -0,0 +1,60 @@
1+(ns glimmer-gfx.tictactoe
2+ "Tic-tac-toe on the gfx backend: a 3x3 grid of buttons and one pure rule.
3+
4+ The board is a vector of 9 cells, each :x, :o or nil. You are X; O replies
5+ with the first free square, which is dumb on purpose -- the point here is
6+ that a game is just another glimmer component."
7+ (:require [glimmer.ratom :as ra]
8+ [glimmer.core :as ui]
9+ [glimmer-gfx.core]))
10+
11+(def ^:private lines
12+ [[0 1 2] [3 4 5] [6 7 8] [0 3 6] [1 4 7] [2 5 8] [0 4 8] [2 4 6]])
13+
14+(defn winner
15+ "The mark occupying a whole line, or nil."
16+ [board]
17+ (some (fn [l] (let [[a b c] (map board l)] (when (and a (= a b c)) a))) lines))
18+
19+(defn reply
20+ "O's move: the first empty square. ponytail: no minimax, add one when losing
21+ to this stops being funny."
22+ [board]
23+ (first (remove #(board %) (range 9))))
24+
25+(defn play
26+ "X takes `i`, then O replies -- unless the game is already over."
27+ [board i]
28+ (if (or (board i) (winner board))
29+ board
30+ (let [b (assoc board i :x)]
31+ (if-let [o (and (not (winner b)) (reply b))] (assoc b o :o) b))))
32+
33+(def ^:private empty-board (vec (repeat 9 nil)))
34+(def state (ra/atom empty-board))
35+
36+(defn- status [board]
37+ (case (winner board)
38+ :x "You win"
39+ :o "O wins"
40+ (if (every? some? board) "Draw" "Your turn")))
41+
42+(defn- cell [board i]
43+ [:button {:label (case (board i) :x "X" :o "O" " ")
44+ :kind (when (= :x (board i)) :primary)
45+ :on-click #(ra/swap! state play i)}])
46+
47+(defn app []
48+ (let [board (ra/deref state)]
49+ [:page {:max-width 300}
50+ [:card {:spacing 8}
51+ [:title {:label "Tic-tac-toe"}]
52+ [:label {:label (status board)}]
53+ (into [:vbox {:spacing 6}]
54+ (for [row (partition 3 (range 9))]
55+ (into [:hbox {:spacing 6}] (for [i row] (cell board i)))))
56+ [:spacer {:size 4}]
57+ [:button {:label "new game" :on-click #(ra/reset! state empty-board)}]]]))
58+
59+(defn -main [& _]
60+ (ui/run app :title "tic-tac-toe" :width 300 :height 340))
new file mode 100644
@@ -0,0 +1,60 @@
1+(ns glimmer-gfx.tictactoe
2+ "Tic-tac-toe on the gfx backend: a 3x3 grid of buttons and one pure rule.
3+
4+ The board is a vector of 9 cells, each :x, :o or nil. You are X; O replies
5+ with the first free square, which is dumb on purpose -- the point here is
6+ that a game is just another glimmer component."
7+ (:require [glimmer.ratom :as ra]
8+ [glimmer.core :as ui]
9+ [glimmer-gfx.core]))
10+
11+(def ^:private lines
12+ [[0 1 2] [3 4 5] [6 7 8] [0 3 6] [1 4 7] [2 5 8] [0 4 8] [2 4 6]])
13+
14+(defn winner
15+ "The mark occupying a whole line, or nil."
16+ [board]
17+ (some (fn [l] (let [[a b c] (map board l)] (when (and a (= a b c)) a))) lines))
18+
19+(defn reply
20+ "O's move: the first empty square. ponytail: no minimax, add one when losing
21+ to this stops being funny."
22+ [board]
23+ (first (remove #(board %) (range 9))))
24+
25+(defn play
26+ "X takes `i`, then O replies -- unless the game is already over."
27+ [board i]
28+ (if (or (board i) (winner board))
29+ board
30+ (let [b (assoc board i :x)]
31+ (if-let [o (and (not (winner b)) (reply b))] (assoc b o :o) b))))
32+
33+(def ^:private empty-board (vec (repeat 9 nil)))
34+(def state (ra/atom empty-board))
35+
36+(defn- status [board]
37+ (case (winner board)
38+ :x "You win"
39+ :o "O wins"
40+ (if (every? some? board) "Draw" "Your turn")))
41+
42+(defn- cell [board i]
43+ [:button {:label (case (board i) :x "X" :o "O" " ")
44+ :kind (when (= :x (board i)) :primary)
45+ :on-click #(ra/swap! state play i)}])
46+
47+(defn app []
48+ (let [board (ra/deref state)]
49+ [:page {:max-width 300}
50+ [:card {:spacing 8}
51+ [:title {:label "Tic-tac-toe"}]
52+ [:label {:label (status board)}]
53+ (into [:vbox {:spacing 6}]
54+ (for [row (partition 3 (range 9))]
55+ (into [:hbox {:spacing 6}] (for [i row] (cell board i)))))
56+ [:spacer {:size 4}]
57+ [:button {:label "new game" :on-click #(ra/reset! state empty-board)}]]]))
58+
59+(defn -main [& _]
60+ (ui/run app :title "tic-tac-toe" :width 300 :height 340))
modified glimmer-backends/glimmer-gfx/src/glimmer_gfx/raster.clj +8 -0
@@ -43,6 +43,14 @@
4343 (if (<= e2 dx) (+ y sy) y)
4444 (cond-> err (>= e2 dy) (+ dy) (<= e2 dx) (+ dx))))))))
4545
46+(defn poly!
47+ "Closed wireframe through [x y] points. Vector art is lines, so this is the
48+ whole of it. ponytail: outline only -- a filled polygon needs a scanline
49+ pass, add one when something actually has to be solid."
50+ [b pts c]
51+ (doseq [[[x0 y0] [x1 y1]] (map vector pts (concat (rest pts) [(first pts)]))]
52+ (line! b (int x0) (int y0) (int x1) (int y1) c)))
53+
4654 ;; ------------------------------------------------------------------ 3x5 font
4755 ;; Authored as strings so a glyph is readable and fixable in place.
4856
@@ -43,6 +43,14 @@
43 (if (<= e2 dx) (+ y sy) y)43 (if (<= e2 dx) (+ y sy) y)
44 (cond-> err (>= e2 dy) (+ dy) (<= e2 dx) (+ dx))))))))44 (cond-> err (>= e2 dy) (+ dy) (<= e2 dx) (+ dx))))))))
45 45
46+(defn poly!
47+ "Closed wireframe through [x y] points. Vector art is lines, so this is the
48+ whole of it. ponytail: outline only -- a filled polygon needs a scanline
49+ pass, add one when something actually has to be solid."
50+ [b pts c]
51+ (doseq [[[x0 y0] [x1 y1]] (map vector pts (concat (rest pts) [(first pts)]))]
52+ (line! b (int x0) (int y0) (int x1) (int y1) c)))
53+
46 ;; ------------------------------------------------------------------ 3x5 font54 ;; ------------------------------------------------------------------ 3x5 font
47 ;; Authored as strings so a glyph is readable and fixable in place.55 ;; Authored as strings so a glyph is readable and fixable in place.
48 56
modified glimmer-backends/glimmer-gfx/src/glimmer_gfx/x11.clj +13 -2
@@ -28,9 +28,14 @@
2828 (ffi/defcfn x-pending "XPending" [:pointer] :int)
2929 (ffi/defcfn x-next "XNextEvent" [:pointer :pointer] :int)
3030 (ffi/defcfn x-close "XCloseDisplay" [:pointer] :int)
31+(ffi/defcfn x-keysym "XLookupKeysym" [:pointer :int] :ulong)
32+;; Without this a held key repeats as release/press pairs, and a frame can catch
33+;; the key up. Detectable repeat suppresses the synthetic releases.
34+(ffi/defcfn x-detectable-repeat "XkbSetDetectableAutoRepeat"
35+ [:pointer :int :pointer] :int)
3136
3237 (def ^:private ZPixmap 2)
33-(def ^:private event-mask (bit-or 32768 4 8 64 131072)) ; expose|btn|motion|structure
38+(def ^:private event-mask (bit-or 32768 4 8 64 131072 1 2)) ; expose|btn|motion|structure|key
3439
3540 ;; XEvent is a 192-byte union. Offsets verified against X11/Xlib.h with
3641 ;; offsetof on x86-64 -- do not infer one struct's layout from another's:
@@ -43,6 +48,7 @@
4348 (def ^:private EV-X 64) (def ^:private EV-Y 68) (def ^:private EV-DATA 56)
4449 (def ^:private PRESS 4) (def ^:private RELEASE 5)
4550 (def ^:private MOTION 6) (def ^:private CLIENT 33)
51+(def ^:private KEY-DOWN 2) (def ^:private KEY-UP 3)
4652
4753 (defn- drain!
4854 "Fold every queued X event into the input map. :quit? on window close."
@@ -57,6 +63,10 @@
5763 PRESS (assoc in :down? true :mouse p)
5864 RELEASE (assoc in :down? false :released? true :mouse p)
5965 MOTION (assoc in :mouse p)
66+ ;; the keysym, not the raw keycode: it is what the user's
67+ ;; own layout says the key means.
68+ KEY-DOWN (update in :keys conj (x-keysym ev 0))
69+ KEY-UP (update in :keys disj (x-keysym ev 0))
6070 CLIENT (cond-> in
6171 (= wm-delete (ffi/read ev :ulong EV-DATA))
6272 (assoc :quit? true))
@@ -90,7 +100,8 @@
90100 (x-select dpy win event-mask)
91101 (x-map dpy win)
92102 (try
93- (loop [input {:mouse [0 0] :down? false :released? false}]
103+ (x-detectable-repeat dpy 1 ffi/null)
104+ (loop [input {:mouse [0 0] :down? false :released? false :keys #{}}]
94105 (let [input (drain! dpy ev input wm-delete)]
95106 (frame-fn buf input)
96107 (ffi/write-array data :int (:px buf))
@@ -28,9 +28,14 @@
28 (ffi/defcfn x-pending "XPending" [:pointer] :int)28 (ffi/defcfn x-pending "XPending" [:pointer] :int)
29 (ffi/defcfn x-next "XNextEvent" [:pointer :pointer] :int)29 (ffi/defcfn x-next "XNextEvent" [:pointer :pointer] :int)
30 (ffi/defcfn x-close "XCloseDisplay" [:pointer] :int)30 (ffi/defcfn x-close "XCloseDisplay" [:pointer] :int)
31+(ffi/defcfn x-keysym "XLookupKeysym" [:pointer :int] :ulong)
32+;; Without this a held key repeats as release/press pairs, and a frame can catch
33+;; the key up. Detectable repeat suppresses the synthetic releases.
34+(ffi/defcfn x-detectable-repeat "XkbSetDetectableAutoRepeat"
35+ [:pointer :int :pointer] :int)
31 36
32 (def ^:private ZPixmap 2)37 (def ^:private ZPixmap 2)
33-(def ^:private event-mask (bit-or 32768 4 8 64 131072)) ; expose|btn|motion|structure38+(def ^:private event-mask (bit-or 32768 4 8 64 131072 1 2)) ; expose|btn|motion|structure|key
34 39
35 ;; XEvent is a 192-byte union. Offsets verified against X11/Xlib.h with40 ;; XEvent is a 192-byte union. Offsets verified against X11/Xlib.h with
36 ;; offsetof on x86-64 -- do not infer one struct's layout from another's:41 ;; offsetof on x86-64 -- do not infer one struct's layout from another's:
@@ -43,6 +48,7 @@
43 (def ^:private EV-X 64) (def ^:private EV-Y 68) (def ^:private EV-DATA 56)48 (def ^:private EV-X 64) (def ^:private EV-Y 68) (def ^:private EV-DATA 56)
44 (def ^:private PRESS 4) (def ^:private RELEASE 5)49 (def ^:private PRESS 4) (def ^:private RELEASE 5)
45 (def ^:private MOTION 6) (def ^:private CLIENT 33)50 (def ^:private MOTION 6) (def ^:private CLIENT 33)
51+(def ^:private KEY-DOWN 2) (def ^:private KEY-UP 3)
46 52
47 (defn- drain!53 (defn- drain!
48 "Fold every queued X event into the input map. :quit? on window close."54 "Fold every queued X event into the input map. :quit? on window close."
@@ -57,6 +63,10 @@
57 PRESS (assoc in :down? true :mouse p)63 PRESS (assoc in :down? true :mouse p)
58 RELEASE (assoc in :down? false :released? true :mouse p)64 RELEASE (assoc in :down? false :released? true :mouse p)
59 MOTION (assoc in :mouse p)65 MOTION (assoc in :mouse p)
66+ ;; the keysym, not the raw keycode: it is what the user's
67+ ;; own layout says the key means.
68+ KEY-DOWN (update in :keys conj (x-keysym ev 0))
69+ KEY-UP (update in :keys disj (x-keysym ev 0))
60 CLIENT (cond-> in70 CLIENT (cond-> in
61 (= wm-delete (ffi/read ev :ulong EV-DATA))71 (= wm-delete (ffi/read ev :ulong EV-DATA))
62 (assoc :quit? true))72 (assoc :quit? true))
@@ -90,7 +100,8 @@
90 (x-select dpy win event-mask)100 (x-select dpy win event-mask)
91 (x-map dpy win)101 (x-map dpy win)
92 (try102 (try
93- (loop [input {:mouse [0 0] :down? false :released? false}]103+ (x-detectable-repeat dpy 1 ffi/null)
104+ (loop [input {:mouse [0 0] :down? false :released? false :keys #{}}]
94 (let [input (drain! dpy ev input wm-delete)]105 (let [input (drain! dpy ev input wm-delete)]
95 (frame-fn buf input)106 (frame-fn buf input)
96 (ffi/write-array data :int (:px buf))107 (ffi/write-array data :int (:px buf))
modified glimmer-backends/glimmer-gfx/test/glimmer_gfx/tests.clj +99 -0
@@ -6,6 +6,9 @@
66 [glimmer.core :as gui]
77 [glimmer.backend :as backend]
88 [glimmer-gfx.core :as gfx]
9+ [glimmer-gfx.tictactoe :as ttt]
10+ [glimmer-gfx.maze :as maze]
11+ [glimmer-gfx.asteroids :as ast]
912 [glimmer-gfx.raster :as r]
1013 [clojure.string :as str]))
1114
@@ -109,8 +112,104 @@
109112 "the scheduled re-render never reached the tree"))
110113 (finally (reset! backend/loop-running? false))))
111114
115+;; --- asteroids ----------------------------------------------------------------
116+
117+(defn- check-asteroids! []
118+ (assert (= [5.0 5.0] (ast/wrap [645.0 485.0])) "the world must wrap")
119+ (assert (ast/hit? [10 10] [12 12] 5))
120+ (assert (not (ast/hit? [10 10] [200 200] 5)))
121+ (assert (ast/hit? [5 5] [635 475] 20) "a hit across the seam still counts")
122+ (let [g (ast/new-game)
123+ ;; thrust moves the ship; nothing else does
124+ drifting (nth (iterate #(ast/step % #{0x77}) g) 5)]
125+ (assert (not= (get-in g [:ship :pos]) (get-in drifting [:ship :pos]))
126+ "thrust did not move the ship")
127+ (assert (:thrusting (:ship drifting)))
128+ ;; turning is a rotation, not a translation
129+ (let [turned (ast/step g #{0xff53})]
130+ (assert (pos? (get-in turned [:ship :angle])) "right did not turn"))
131+ ;; holding space auto-fires, but paced -- not one bullet per frame
132+ (let [a (ast/step g #{0x20})
133+ b (ast/step a #{0x20})
134+ held (nth (iterate #(ast/step % #{0x20}) g) 20)]
135+ (assert (= 1 (count (:bullets a))) "space did not fire")
136+ (assert (= 1 (count (:bullets b))) "the cooldown did not hold the trigger")
137+ (assert (< 1 (count (:bullets held)) 20) "auto-fire is off, or unpaced"))
138+ ;; a bullet placed on a rock splits it and scores
139+ (let [rk (assoc (first (:rocks g)) :pos [100 100] :vel [0 0] :size 3)
140+ st (ast/step (assoc g :rocks [rk]
141+ :bullets [{:pos [100 100] :vel [0 0] :life 30}])
142+ #{})]
143+ (assert (= 2 (count (:rocks st))) "the rock did not split in two")
144+ (assert (every? #(= 2 (:size %)) (:rocks st)) "the pieces are the wrong size")
145+ (assert (= 10 (:score st)) "no score for the hit")
146+ (assert (empty? (:bullets st)) "the bullet survived its own hit"))
147+ ;; the smallest rock leaves nothing behind, and an empty field respawns
148+ (let [rk (assoc (first (:rocks g)) :pos [100 100] :vel [0 0] :size 1)
149+ st (ast/step (assoc g :rocks [rk]
150+ :bullets [{:pos [100 100] :vel [0 0] :life 30}])
151+ #{})]
152+ (assert (seq (:rocks st)) "an empty field should respawn")
153+ (assert (every? #(= 3 (:size %)) (:rocks st)) "respawned rocks are not full size"))
154+ ;; a rock on top of the ship ends it
155+ (let [rk (assoc (first (:rocks g)) :pos (get-in g [:ship :pos]) :vel [0 0])]
156+ (assert (:lost? (ast/step (assoc g :rocks [rk]) #{}))))
157+ ;; and it all paints: poly! into a real framebuffer, nothing thrown
158+ (let [buf (r/buf 640 480)]
159+ (@#'ast/draw! buf (nth (iterate #(ast/step % #{0x77 0x20}) g) 30))
160+ (assert (some #(not= (:bg @#'ast/colours) %) (seq ^ints (:px buf)))
161+ "the frame painted nothing"))
162+ ;; bullets expire
163+ (let [st (ast/step (assoc g :bullets [{:pos [10 10] :vel [0 0] :life 1}]) #{})]
164+ (assert (empty? (:bullets st)) "the bullet outlived its life"))))
165+
166+;; --- the maze -----------------------------------------------------------------
167+
168+(defn- check-maze! []
169+ (let [level ["####" "#..#" "#..#" "####"]
170+ C 24]
171+ (assert (maze/wall? level 0 0))
172+ (assert (not (maze/wall? level 1 1)))
173+ (assert (maze/wall? level 9 9) "off the map must read as wall")
174+ (assert (maze/free? level C C) "the open cell should be free")
175+ (assert (not (maze/free? level (+ (* 2 C) 1) C))
176+ "a box straddling the far wall is not free")
177+ ;; walking into a wall costs the blocked axis only: this slides down it
178+ (let [p [C C]]
179+ (assert (= p (maze/move level p [-1 0])) "moved through a wall")
180+ (assert (= p (maze/move level p [0 0])))
181+ (let [[x y] (maze/move level [(* 2 C) C] [1 1])]
182+ (assert (= x (* 2 C)) "should have been stopped by the wall on the right")
183+ (assert (> y C) "but should still have slid downward")))
184+ ;; the dot under the player's centre is the one that goes
185+ (assert (= #{[2 1]} (maze/eat #{[1 1] [2 1]} [C C])))))
186+
187+;; --- the game ----------------------------------------------------------------
188+
189+(defn- check-tictactoe! []
190+ (let [empty (vec (repeat 9 nil))]
191+ (assert (nil? (ttt/winner empty)))
192+ (assert (= :x (ttt/winner [:x :x :x nil nil nil nil nil nil])))
193+ (assert (= :o (ttt/winner [:x :x nil nil nil nil :o :o :o])))
194+ (assert (nil? (ttt/winner [:x :x :o nil nil nil nil nil nil])))
195+ ;; X plays 4, O answers in the first free square
196+ (let [b (ttt/play empty 4)]
197+ (assert (= :x (b 4)) "X did not take the square it clicked")
198+ (assert (= :o (b 0)) "O did not reply"))
199+ ;; an occupied square, and a finished game, are both no-ops
200+ (assert (= (ttt/play empty 4) (ttt/play (ttt/play empty 4) 4)))
201+ (let [won [:x :x :x :o :o nil nil nil nil]]
202+ (assert (= won (ttt/play won 5)) "the board moved after the game was over"))
203+ ;; a winning move ends it: no reply gets appended
204+ (let [b (ttt/play [:x :x nil :o :o nil nil nil nil] 2)]
205+ (assert (= :x (ttt/winner b)))
206+ (assert (nil? (b 5)) "O replied to a move that had already won"))))
207+
112208 (defn -main [& _]
113209 (check-raster!)
210+ (check-tictactoe!)
211+ (check-maze!)
212+ (check-asteroids!)
114213 (let [root (gfx/root-node)
115214 buf (r/buf 400 240)]
116215 (gui/mount root :vbox [counter])
@@ -6,6 +6,9 @@
6 [glimmer.core :as gui]6 [glimmer.core :as gui]
7 [glimmer.backend :as backend]7 [glimmer.backend :as backend]
8 [glimmer-gfx.core :as gfx]8 [glimmer-gfx.core :as gfx]
9+ [glimmer-gfx.tictactoe :as ttt]
10+ [glimmer-gfx.maze :as maze]
11+ [glimmer-gfx.asteroids :as ast]
9 [glimmer-gfx.raster :as r]12 [glimmer-gfx.raster :as r]
10 [clojure.string :as str]))13 [clojure.string :as str]))
11 14
@@ -109,8 +112,104 @@
109 "the scheduled re-render never reached the tree"))112 "the scheduled re-render never reached the tree"))
110 (finally (reset! backend/loop-running? false))))113 (finally (reset! backend/loop-running? false))))
111 114
115+;; --- asteroids ----------------------------------------------------------------
116+
117+(defn- check-asteroids! []
118+ (assert (= [5.0 5.0] (ast/wrap [645.0 485.0])) "the world must wrap")
119+ (assert (ast/hit? [10 10] [12 12] 5))
120+ (assert (not (ast/hit? [10 10] [200 200] 5)))
121+ (assert (ast/hit? [5 5] [635 475] 20) "a hit across the seam still counts")
122+ (let [g (ast/new-game)
123+ ;; thrust moves the ship; nothing else does
124+ drifting (nth (iterate #(ast/step % #{0x77}) g) 5)]
125+ (assert (not= (get-in g [:ship :pos]) (get-in drifting [:ship :pos]))
126+ "thrust did not move the ship")
127+ (assert (:thrusting (:ship drifting)))
128+ ;; turning is a rotation, not a translation
129+ (let [turned (ast/step g #{0xff53})]
130+ (assert (pos? (get-in turned [:ship :angle])) "right did not turn"))
131+ ;; holding space auto-fires, but paced -- not one bullet per frame
132+ (let [a (ast/step g #{0x20})
133+ b (ast/step a #{0x20})
134+ held (nth (iterate #(ast/step % #{0x20}) g) 20)]
135+ (assert (= 1 (count (:bullets a))) "space did not fire")
136+ (assert (= 1 (count (:bullets b))) "the cooldown did not hold the trigger")
137+ (assert (< 1 (count (:bullets held)) 20) "auto-fire is off, or unpaced"))
138+ ;; a bullet placed on a rock splits it and scores
139+ (let [rk (assoc (first (:rocks g)) :pos [100 100] :vel [0 0] :size 3)
140+ st (ast/step (assoc g :rocks [rk]
141+ :bullets [{:pos [100 100] :vel [0 0] :life 30}])
142+ #{})]
143+ (assert (= 2 (count (:rocks st))) "the rock did not split in two")
144+ (assert (every? #(= 2 (:size %)) (:rocks st)) "the pieces are the wrong size")
145+ (assert (= 10 (:score st)) "no score for the hit")
146+ (assert (empty? (:bullets st)) "the bullet survived its own hit"))
147+ ;; the smallest rock leaves nothing behind, and an empty field respawns
148+ (let [rk (assoc (first (:rocks g)) :pos [100 100] :vel [0 0] :size 1)
149+ st (ast/step (assoc g :rocks [rk]
150+ :bullets [{:pos [100 100] :vel [0 0] :life 30}])
151+ #{})]
152+ (assert (seq (:rocks st)) "an empty field should respawn")
153+ (assert (every? #(= 3 (:size %)) (:rocks st)) "respawned rocks are not full size"))
154+ ;; a rock on top of the ship ends it
155+ (let [rk (assoc (first (:rocks g)) :pos (get-in g [:ship :pos]) :vel [0 0])]
156+ (assert (:lost? (ast/step (assoc g :rocks [rk]) #{}))))
157+ ;; and it all paints: poly! into a real framebuffer, nothing thrown
158+ (let [buf (r/buf 640 480)]
159+ (@#'ast/draw! buf (nth (iterate #(ast/step % #{0x77 0x20}) g) 30))
160+ (assert (some #(not= (:bg @#'ast/colours) %) (seq ^ints (:px buf)))
161+ "the frame painted nothing"))
162+ ;; bullets expire
163+ (let [st (ast/step (assoc g :bullets [{:pos [10 10] :vel [0 0] :life 1}]) #{})]
164+ (assert (empty? (:bullets st)) "the bullet outlived its life"))))
165+
166+;; --- the maze -----------------------------------------------------------------
167+
168+(defn- check-maze! []
169+ (let [level ["####" "#..#" "#..#" "####"]
170+ C 24]
171+ (assert (maze/wall? level 0 0))
172+ (assert (not (maze/wall? level 1 1)))
173+ (assert (maze/wall? level 9 9) "off the map must read as wall")
174+ (assert (maze/free? level C C) "the open cell should be free")
175+ (assert (not (maze/free? level (+ (* 2 C) 1) C))
176+ "a box straddling the far wall is not free")
177+ ;; walking into a wall costs the blocked axis only: this slides down it
178+ (let [p [C C]]
179+ (assert (= p (maze/move level p [-1 0])) "moved through a wall")
180+ (assert (= p (maze/move level p [0 0])))
181+ (let [[x y] (maze/move level [(* 2 C) C] [1 1])]
182+ (assert (= x (* 2 C)) "should have been stopped by the wall on the right")
183+ (assert (> y C) "but should still have slid downward")))
184+ ;; the dot under the player's centre is the one that goes
185+ (assert (= #{[2 1]} (maze/eat #{[1 1] [2 1]} [C C])))))
186+
187+;; --- the game ----------------------------------------------------------------
188+
189+(defn- check-tictactoe! []
190+ (let [empty (vec (repeat 9 nil))]
191+ (assert (nil? (ttt/winner empty)))
192+ (assert (= :x (ttt/winner [:x :x :x nil nil nil nil nil nil])))
193+ (assert (= :o (ttt/winner [:x :x nil nil nil nil :o :o :o])))
194+ (assert (nil? (ttt/winner [:x :x :o nil nil nil nil nil nil])))
195+ ;; X plays 4, O answers in the first free square
196+ (let [b (ttt/play empty 4)]
197+ (assert (= :x (b 4)) "X did not take the square it clicked")
198+ (assert (= :o (b 0)) "O did not reply"))
199+ ;; an occupied square, and a finished game, are both no-ops
200+ (assert (= (ttt/play empty 4) (ttt/play (ttt/play empty 4) 4)))
201+ (let [won [:x :x :x :o :o nil nil nil nil]]
202+ (assert (= won (ttt/play won 5)) "the board moved after the game was over"))
203+ ;; a winning move ends it: no reply gets appended
204+ (let [b (ttt/play [:x :x nil :o :o nil nil nil nil] 2)]
205+ (assert (= :x (ttt/winner b)))
206+ (assert (nil? (b 5)) "O replied to a move that had already won"))))
207+
112 (defn -main [& _]208 (defn -main [& _]
113 (check-raster!)209 (check-raster!)
210+ (check-tictactoe!)
211+ (check-maze!)
212+ (check-asteroids!)
114 (let [root (gfx/root-node)213 (let [root (gfx/root-node)
115 buf (r/buf 400 240)]214 buf (r/buf 400 240)]
116 (gui/mount root :vbox [counter])215 (gui/mount root :vbox [counter])