nandi/jolt-native · maze.clj

⑂ main

maze.clj · 100 lines · 3.4 KBClojure    Blame HistoryRaw
Play three games on the gfx backend   1(ns glimmer-gfx.maze
"A WASD game on the same two files the widgets use, and nothing else.
 There is no glimmer here: a reconciler is for a UI that changes when state
 changes, and this changes sixty times a second whatever you do. So it takes
 the layer below -- x11 gives a framebuffer and the keys held this frame,
 raster draws into it -- which is the whole of what a game loop needs.
 Walk over the dots, don't walk through walls."
(:require [glimmer-gfx.raster :as r]
          [glimmer-gfx.x11 :as w]))
13(def ^:private CELL 24)
14(def ^:private SPEED 3)                                  ; pixels per frame
16;; keysyms, as XLookupKeysym reports them
17(def ^:private keymap
{0x77 [0 -1] 0x73 [0 1] 0x61 [-1 0] 0x64 [1 0]          ; w s a d
 0xff52 [0 -1] 0xff54 [0 1] 0xff51 [-1 0] 0xff53 [1 0]}) ; arrows
21(def ^:private level
["###################"
 "#....#........#...#"
 "#.##.#.######.#.#.#"
 "#.#..........#..#.#"
 "#.#.####.###.####.#"
 "#...#......#......#"
 "#.###.####.#.####.#"
 "#.....#......#....#"
 "###################"])
32(defn wall? [level c r]
(let [row (get level r)]
  (or (nil? row) (not= \. (get row c \#)))))
36(defn- cells-under
"The grid cells a CELL-sized box at (x,y) overlaps."
(for [c [(quot x CELL) (quot (+ x CELL -1) CELL)]
      r [(quot y CELL) (quot (+ y CELL -1) CELL)]]
  [c r]))
43(defn free?
"May the player box sit at (x,y)?"
[level x y]
(and (>= x 0) (>= y 0)
     (every? (fn [[c r]] (not (wall? level c r))) (cells-under x y))))
49
"Slide along a wall rather than stopping dead: each axis is tried alone."
[level [x y] [dx dy]]
(let [x' (if (free? level (+ x (* dx SPEED)) y) (+ x (* dx SPEED)) x)
      y' (if (free? level x' (+ y (* dy SPEED))) (+ y (* dy SPEED)) y)]
  [x' y']))
56(defn- dir [keys]
(let [[dx dy] (reduce (fn [a b] (mapv + a b)) [0 0]
                      (keep keymap keys))]
  [(min 1 (max -1 dx)) (min 1 (max -1 dy))]))
61(defn- dots [level]
(set (for [r (range (count level)) c (range (count (level r)))
           :when (= \. (get (level r) c))
           :when (odd? (+ c r))]                       ; every other cell
       [c r])))
67
"The dot the player's centre is standing on, removed."
[dots [x y]]
(disj dots [(quot (+ x (quot CELL 2)) CELL) (quot (+ y (quot CELL 2)) CELL)]))
72(def ^:private colours
{:bg 0x1c1e26 :wall 0x373b49 :dot 0x9aa0b0 :player 0x5a6ea0 :fg 0xffffff})
75(defn- draw! [buf {:keys [pos dots]}]
(r/clear buf (:bg colours))
(dotimes [r (count level)]
  (dotimes [c (count (level r))]
    (when (wall? level c r)
      (r/rect! buf (* c CELL) (* r CELL) (dec CELL) (dec CELL) (:wall colours)))))
(doseq [[c r] dots]
  (r/rect! buf (+ 9 (* c CELL)) (+ 9 (* r CELL)) 6 6 (:dot colours)))
(let [[x y] pos]
  (r/rect! buf (inc x) (inc y) (- CELL 2) (- CELL 2) (:player colours)))
(let [y (* CELL (count level))]
  (r/text! buf 8 (+ y 8)
           (if (empty? dots) "CLEARED" (str "DOTS LEFT: " (count dots)))
           (:fg colours) 2)))
90(defn -main [& _]
(let [state (atom {:pos [CELL CELL] :dots (dots level)})]
  (w/run-window
    {:width (* CELL (count (first level)))
     :height (+ 32 (* CELL (count level)))
     :title "maze"}
    (fn [buf input]
      (draw! buf (swap! state
                        (fn [{:keys [pos dots]}]
                          (let [pos (move level pos (dir (:keys input)))]
                            {:pos pos :dots (eat dots pos)}))))))))

Play three games on the gfx backend e98a184 nandi 11d ago	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)}))))))))